38888 


ASAAOAAAOAAAOOOO 
AOOOIOOAOAAOOOOAO 
AOAAAAOAOAOOAONY 


SSSSSSSsss 


AAA AA Ht St tH A 
AAA St A 
AAAS AS a a st st se 


L 

LLLLLLLLLLLLLLL 
LLELLLLLLLLLELLLL 
LLLLLLLLLLLLLLL 


ad 


| #*F ILE®*1D**COBDISPLA 
| 

CCCCCCCE §=©— 000000 «Ss BBBBBBBB ©—«dDD ILI SSSSSSSS$_PPPPPPPP LL AAAAAA 
CCCCCCCC 000000 DDDDDDDD HII SSSSSSSS PPPPPPPP LL AAAAAA 

CC 00 00 88 BB DD DD II S$ pp PP LL AA AA 

CC 00 00 88 BB DD dD II S$ PP PP LL AA AA 

CC 00 00 88 BB DD DD II S$ pp PP LL AA AA 

CC 00 00 88 BB DD dD I S$ PP PP LL AA AA 

CC 00 00 BB8BBBBBB DD DD I SSSSSS_- PPPPPPPP) ss LL AA AA 

CC 00 00 88888888 DD dD 1] SSSSSS__-PPPPPPPP = LL AA AA 

CC 00 00 8B BB DD dD II SS PP LL AAAAAAAAAA 

CC 00 00 88 BB DD dD II SS PP LL AAAAAAAAAA 

CC 00 00 88 BB DD DD II SS PP LL AA AA Poe 

cc 00 00 88 BB OD DD II SS PP LL AA AA ati 
CCCCCCCC © 000000 ~©=s-« BBBBBBBB ©—«-ODDDDDDD IIII11  SSSSSSSS—— PP LLLLLLLLLL AA AA note 
CCCCCCCC 000000 BBBBBBBB DDDDDDDD 111111 SSSSSSSS_— PP LLLLLLLLLL AA AA “ack 

LL WII SSSSSSSS 

LL HII SSSSSSSS 

LL 11 SS 

LL II SS 

LL I] SS 

LL I] $$ 

LL 11 SSSSSS 

LL 11 SSSSSS 

LL 11 $$ 

LL Il SS 

LL 1] SS 

LL 1] S$ 

LLLLLLLLLL IIIIII © SSSSSSSS 

LLLLLLLLLL HII] SSSSSSSS 


pan oe eer er Tg Seadicns 
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COBSDISPLAY VAX=11 COBOL DISPLAY statement hes Sep-1984 ¢ 98: 96:3) AX-11 Bliss-32 V4.0-74 Page 1 

14-Sep-1984 COBRTL.SRCJCOBDISPLA.852;1 (1) 
: 1 1 MODULE COBSDISPLAY ( Z%TIT LE. wane" COBOL p SPLAY statement 
; § 0 § IDENT = '1-015° ' File: Cossiseea 532 ED!IT:LGB1015 
3 4 o | BEGIN 
: § Oo8 : Deities piacagcelenouar ater ger eenereireareney 
Py .* tt 
3 8 08 1 !* COPYRIGHT (c) 1978, 1980, 1982, 1984 B * 
H 4 0009 1 !* DIGITAL at be CORPORATION, MAYNARD. MASSACHUSETTS. © 
3 19 Bere : - ALL RIGHTS RESERVED. * 
Py : oa 
; 1 Bog 1 !e hg eer IS FURNISHED UNDER A LICENSE AND MAY BE USED AND ag he * 
; 1 01 1 !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * 
$ 14 0014 1 !« LUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY THE * 
; 15 0015 1 !« ak a THEREOF MAY NOT BE OVIDED OR OTHERWISE MADE AVAILABLE TO ANY * 
4 16 3018 1 !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ® 
3 i? Sole : :* TRANSFERRED. * 
Py iH wv 
$ 19 0019 1 !* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * 
; $9 0020 1 !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
; $3 B05; : :* CORPORATION. * 
; '® e 
$ 38 0038 1 != DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * 
3 4 0024 1 !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * 
$ 25 0025 1! a 
b4 26 0026 1 !« * 
; $i 4 34 : , Seeeaeeserenrcerensesesenonsoeeoeereeeeseeeeeteteteneneneaterereteeteeetetes 
; 29 00¢9 1: 
3 0 0030 1 
3 H 0031 1 !4+ 
: 2 4 1 ! FACILITY: COBOL SUPPORT 
: » 0035 1! 
3 34 0034 1 ! ABSTRACT: 
ct om 0035 1! 
; 36 0036 1! Supports the COBOL DISPLAY and DISPLAY WITH NO ADVANCING 
eae 0037 1! statements. Enhanced to perform the new screen handling 
: $ st : } extensions for VAX-11 COBOL Version 3. 
: re Beco : Contains COBSSOPEN_OUT to open an RMS file for output. 
: 42 004¢ 1 i Avoids use of STRSCONCAT to avoid its overhead. The 
s 65 00435 1! concatenation which needs to be done is done inline since 
; ts bee ! } alt required lengths are known. 
; 46 0046 ' ENVIRONMENT: VAX=11 User Mode 
: 48 0048 AUTHOR: Rich Reichert, CREATION DATE: 17-JULY-79 
: 50 50 1 | MODIFIED BY: 
ae $3) + 
: 2g 26 1! 1-00) - Original. RKR 17-JULY-79 
i 0055 1 ! 1-002 - Remove usage of STRSCONCAT and associated string routines, 
; «656 bnee 1! as well as ainer £ foes rearrangements to improve resulting 
3 35 055 1! code. RKR 17=-S 
; 8938 1 ! 1-003 - Change basic aigorithe for concatenation. 
5 wT 0057 1! If 1 string, write from caller's buffer 


Cael ae tea ls en es POM Bataan 


Sopee eri ar VAX=11 COBOL DISPLAY statement ese -Sep-1984 t 98: oF: 3) AX-11 Bliss-32 V4.0 "a 
14-Sep-1984 COBRTL.SRC COBDISPLA. B32;1 (1) 


pet want a SIGN printed in a COM dete item. 
PIC P data item addressed. 
LGB 15-AUG-8 
1-014 = Added routine to return address of wor: PREV. okie be needed 


; 28 1! If more than 1 string and total length less than 132 chars, 

; 9 7 concatenated on stack. 

; 60 1: Else ofoncatenate in heap storage. 

; 66) 1! RKR 2 

3 6¢ 1 ! 1-004 = Change symbolic name of LIBRARY file. RKR 1-0CT-79 

; § 1 ! 1-005 = Change references e LI -INVAR to COBS_INVARG 

; 64 1} Cosmetic . anges. 

3; 1! 1- 6 - Make sensitive to REQUIRE. file. BER ¢ -0CT-79 

; &* 1! I- - Improve error messages. RKR 21-O0CT-7 

hod 1 ! 1-008 - Pass filename descriptor to COBSSWRITE_RMS so that we have 

3 os : } {tlengne ov av ytable for signaling if errors arise. 

: 76 : 1-009 - sy aimatter by creating additional common code. 

: Le: : } 1-010 - Imperative gleen-ups. also try SYS$ logicals. 

s 6 1 ! 1-011 = Added EDIT phrase so CHECKIN creates a valid audit trail. Also 

; 1! yedetes copyright date. LB 9-AUG-81 

= 1 ! 1-012 = Added routines to perform the a screen handling extensions for 
we 1! Version 3 of VAX-11 COBOL. 

ce 1! New routines; 

; 1! COBSDISP_SCR 

; 80 1! COBSDISP-SCR_NO_ADV 

; 8 1! COMMON_ SCREEN 

*. = 1! DISP_ CONVERT 

s ¢ 1! D SE 

; «B4 1! COBSSFREE_STRINGS 

; 1: Changes to old routines; 

; & 1! COBSSOPEN_OUT = made it a GLOBAL routine 

: 87 73 LGB 11-MAR-83 

; «6888 1 ! 1-013 = Additional code for seraen handling extensions. 

H 89 1! ADJUST_FL_PT ma 

; 1! Version 1°/ Version 3 DISPLAY and ety statement interaction, 
; vi 7! COBS$AB_PREV initial state changed fro to 

..) = : VAX=-11 COBOL Compiler now passin a bit in FLAGS if they do 
; 1: 

3 1! 

; 1: 

: 1! by RPGSDSPLY. Routine is COBSSRET_A_AB_ PREV. L 29-AUG-1983 
3 1 ! 1-015 - Parameter added to COBSSOPEN_OUT to Bypass some COBOL a ¥ for 

: : RPG. Wow uses COBPROLOG.REQ? LGB 24-0CT-83 


Kk 3 
ISPLAY VAX=11 COBOL DISPLAY statement -Sep-1 AX-11 Bliss- 4. 
itt mer i2 <8 “19 3b 99: 95:33 COBRTL SRe coapisPrab 2;1 Jat 23 


COBSSFREE oe 
COBSS$RET_A_AB_PREV 


EQUATED SYMBOLS: 
LITERAL 
NUM 


Free local strings 
Retrn os R.. ~ COBSSAB_PREV 


10 1 : 

ioe : : PROLOGUE FILE 

05 1 REQUIRE *RTLIN:COBPROLOG’ ; ! Switches, Psects, 

06 6 ' i Include files. 

4 ? } LINKAGES: 

09 6 LINKAGE 

10 6 CVT_JSB = JSB (REGISTER = g. pert 27 hy * wee = 8, REGISTER = 9) : 
11 6 NOPRESER ve ( 

2 6 NOTUSED (10, 13" F 

1 ° TABLE OF CONTENTS: 

18 6 FORWARD ROUTINE 

1 6 COBSDISPL NOVALUE, ! Display with normal advancing 

18 6 COBSDISP- UNO ADV: NOVALUE, ! Display with no advancing 

19 6 COBSDISP—SCR: NOVALUE, ' Display with screen enhancements 
0 6 ! and normal advancing 
1 6 COBSDISP_SCR_NO_ADV: NOVALUE, ! Display with screen enhancements 
¢ 6 ! and -~ hay py 

$3 COMMON_CODE : NOVALUE, ' Code is 

24 6 ! COBSDISPLAY and "COBSD ISP. NO_ADV 
25 COMMON_CODE_1: NOVALUE, i Code which is 

$$ ! COBSDISPLAY an. or OBsDI SP. NO_ADV 
7 COBSSOPEN_OUT: NOVALUE, ! Open for output 

28 COMMON_SCREEN: NOVALUE, ! Code which is foemen to COBSDISP_SCR 
7 ! and COBSDISP_SCR ADV 
DISP_CONVERT: NOVALUE, ' Numeric ceainetion® 
32 DISP-PARSE: NOVALUE, Put Sppetser string for output 
' 

34 
5 


3 7 
». 
s F 
s 6 
os 
He. 
.: 7 
3 
3 3 
.. 3% 
3; 
2 
ss 
3 7 
3; 3 
3 3 
cen 
s 3% 
3 
se 
es 
3 
3 7% 
3 3 
; 3 
cis 
sy 
s.¥ 
3 3 
; 
3 3% 
..% 
5s ¥ 
g f 
9 
» 3 
; ¥% 
; 
wa 
. ¥ 
3 ¥ 
3s ¥ 
; F 
i, 
_. 
a 
3 4% 
:. 3 
. % 
s CY 
5 
3; 
3 1 
3 7 
3 7 
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4 UNITS = COBSK_UNIT_MAX = COBSK_UNIT_MIN + 1;  ! Number of units 

40 LITERAL 

41 DISP = 0, ' Code for D 

ri} DNA = 1, ! Code for DISPLAY with no advancing 

4 POS = 2, ' Code for COBSPOS_ERASE being cotlee ms a to 
44 65 ! entrance to this module (prev - display) 

45 66 POS_DNA = 3, ' Code for COBSPOS oERASE being cal ied prior to 
rs 66 ' entrance to this module Soret, - disp no adv) 
4 66 ACC_ADV = 4, ! Code for ACCEPT Advancing (v3) 

48 66 ACC“DNA = 5, ! Code for ACCEPT No Advancing (V3) 

49 664 C = 2X"8D', ! Code for carriage return 

50 665 LINE FEED = %x‘8A', ' Code for Line-feed 

51 666 v_BECL s 18. ' Bit flag for terminal bell 

6 66 v_CONV = 32, : Bit flag for conversion 

5 668 V_DEC_PT = 64 ! Bit flag for decimal po nt is comma 

54 9 VINO SIGN = 128 i Bit flag for COMP data itens, 1=do a print sign 
55 670 V~COB_RPG = é 46, | Bit flag for VAX COBOL / 

26 671 FCAG_MASK = 15 ; ! Masks first four bits of FLAGS (0-3) for gall 
5 676 ' to COBSSSET gat TAsGures (bold, reverse, blink, 
58 67 ! and underline) 


3 
pst aoe hmmm sorter ome IECSESHBEL QRHE:RD WSN SEER MSHA. a 


= 
uw 
~o 


GUARDS: 


Since the code assumes that COBSK_UNIT_MIN equals 0, and COB_TABLE 
has only 7 items in it, we safeguard this module. 


F COBSK_UNIT_MIN NEQ 0 ZTHEN ZERROR('Unexpected COBSK_UNIT_MIN value’ 
F COBSK_UNIT_MAX GTR 6 ZTHEN ZERROR('Unexpected COBSK_UNIT_MAX value’ 


—OODONOUSE 


- pepe 
ee 
we 


ye 


OWN STORAGE: 
The following GLOBAL cells are used by the file 1/0 routines. 
GLOBAL 
COBSSAL_WRITE_RAB: V 
INITIAL (¢ 
COBSSAW_WRITE_IFI: ) 
COBS$AB_USPCODE: V 
V 
( 


COBSSAB_PREV: 
INITIAL 


TORCNUM_UNITS) 
en UNITS OF LONG (0)), ! Address of output RAB 


NOM_UNITS, WORD] 
P NUM_UNITS OF WORD (0)), Internal file identifiers 
TORC2, BYTE), byte 0 is prefix upspacing 

byte 1 is post upspac ing 
TOR CNUM_UNITS, BYTE] History of whether previous call was 
P NUM_UNTTS OF BYTE (9)) ; a DISPLAY or DISPLAY_NO_ADV 


PORAAGCAOASAAO 
SPSL SSa ue 
MEW —OO° uw 


S353 
S33 


ce ce ee me me ee ee Dc ee ee ee ee ee ee ee ed ed od ed od 


MACROS: 


Adjust the output of the OTS$ routines that convert Floating Point 
and Double Floating Point to Text. 
d result 0.1110000E+03, now want 1.110000E+02 


SSSVRALAVLSSSVSASANIASSSUSALERLIS 
Oo 
Wn—o 


aaa aa a ak a ad at ts = 2 SS 2 a ts a ot Ss os to So SS 


ae ee ee ee eee ee ee ee ee ee ee ee ee ee ee ee SY 


04 CRO 
m 1705 ADJUST_FL_PT = 

91 M BS 

36 Mm 170 BEGIN ! Begin FL macro 

G M 1708 

94 m 1709 LOCAL 

95 mM 1710 ANS_ BUF : REF VECTOR (25,BYTE], 

96 M1711 E_SIGN, ! sign position of exp 
97 M re E_ONES, ! ones position of exp 
98 4 171 E TENS ! tens position of exp 
99 M1714 SAIFT ALL, i # of chars to shift 
00 M1715 SEARCA, ! # of chars to search 
01 M 1716 CHANGE, ! =1 if e+00 should be 
4 M1717 ' changed to e-01 

b7 . At TEMP : BYTE; ! Needed for exchange 
05 ™ 1720 ANS_BUF = .ANS_STRING COSCSA_POINTER) ; 

53 " r 1 IF T.STRING COSC$B_DTYPE) EQC DSCSK_DTYPE_F ) 

08 M17 - BEGIN ! Floatin 

09 M 1724 E_SIGN = 11; ! Where to find exponent 
10 M 1725 E_ONES = 13; ! im ANS_STRING 

11 417 $ E_TENS = 1§ : 

\¢ . 4 SRIFT ALL = 12; ! Shift 12 chars for FL 
14 417 § ELSE ' Double Floating 
215 M 1730 BEGIN 


| a 3 
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SVSVBVSVSTSBSSSSSSSSSSSTSSTSSSESTESSTSSTSSTSTSSSSSSSESSESISSISIISISITISIISIIISTsZ 
tet watt adidas atatadatadatadaadaad  ad ed ad ded adadad dad abadadadadadadadadadbadadadbababababad 


Mal NO OOOOOOOO Oa een ae 


SANS 
NOuw 


FEW 


WN SO OONAUSWN $$ O OONOAUES WIN O OONOUS Win 


PXREAAAAGSIVIIUI SE EEE 


o 


SF 
ee ce ee me me ee ee cc ee ee me ee ee ee ee ee ee ce ee ee ce ce ee ce ee ee eB ee ed ed ed od od ed 


E_SIGN = 3 ! Where to find exponent 
E_ONES = 3 ! in ANS_STRING 

E_TENS = 3 

SATPT ALL = 21; ! Shift 21 chars for D FL 


14 
! "Decimal Point is Comma’ = place comma in ANS_BUF to overwrite 
! decimal point that is already there. 


IF (.FLAGS AND V_DEC_PT) NEQ 0 
ANS_BUF [2] = %C',' ; 


4 
! Adjust exponent = decrement if positive, increment if negative. 
! However leave 0.00..00E+00 as is. 


IF (ANS BUF C.E_ONES] EQL %C°O* ) AND (.ANS_BUF C.E_TENS] EQL %C'0") 
BEGIN 
; E+00 => E-01 => but Leave 0.00...00E+00 as is. 
if .SHIFT_ALL gaL 12 
THEN SEARTH = 
ELSE SEARCH = 18; 
INCR P FROM 3 TO :SEA 
IF .ANS_BUF C.P] 
THEN CHANGE = 1 
IF .CHANGE EQL 1 
THEN 


! Change xxxE+00 to 
! xxxE=01 


ELSE 
IF (,ANS_BUF C.E_SIGN) EQL %C*+" ) 
THEN 


4 
; Exponent is positive - decrement it 


BEGIN 
IF (.ANS_BUF C.E_ONES) NEQ %C'0") 


! £418 -> E417 
gc lNS-BUF C-E_ONES2 = .ANS_BUF C.£_ONES) - 1 
! £420 => E419 


Ux'39° ; 
.ANS_BuF C.E_TENS] - 1; 


wn 
@ 
Cc 
eal 
oO 
m 
| 
=O 
m2 
zm 
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me + | talent VAX=11 COBOL DISPLAY statement 13-8 8=}3Re 90:06:33 arate taricas Veen B$2:1 


COBR COBDISP 
3 7 417 3 1 END 
: She m 1790 anu 
: g 1731 ; Exponent negative - increment it 
: 237 ¥ 1338 1 BEGIN 
3 7 m1794 #1 IF (.ANS_BUF C.E_ONES] NEQ %C'9') 
; 280 m1795 1 THEN ! €=15 => E=16 
4 81 M 1738 1 ANS_BUF C.E_ONES] = .ANS_BUF C.E_ONES] + 1 
3 8 ”1797 #1 ELSE 
3; 2 ™1798 1 ! £420 => £419 
3 ge ™1799 1 ANS_BUF +E -0NES} = %x'30° ; 
; 285 m 1800 1 ANS~BUF C.E-TENS] = .ANS_BUF C.E_TENS] + 1 ; 
; 286 ™ 1801 1 END’; 
; 287 M 1306 1 END ; 
; 288 ™ 1805 1 END ; 
2. 
: 291 M 1908 1 i Exchange decimal point and gipts you want before the decimal point 
; 2 ™ 1807 1 ! Mantissa was 0.125... now will be 01.25... 
i $8 m 1809 oi 
: 295 ™ 1810 1 TEMP = .ANS_BUF 2) : 
: 296 m 1811 1 ANS_BUF i = .ANS_BUF 33 
: 97 M sig 1 ANS_BUF ] = . TEMP ; 
oy 
: 00 ™ 1815 1 i Pull the zero that is before the decimal point. Shift the other 
3; 301 m 1816 1 ! digits by one. 
; Oe m 1817 1 ! Old result 0.1110000E +03, 
; 3» m 1818 1 : from exchange above 01.110000E+02, 
3; 304 m 1819 1 ! now want 1.110000E +02 
: 306 m1eo1 z 
: 307 1892 1 INCR X FROM 1 TO .SHIFT_ALL DO 
; 308 ia] 186 1 ANS_BUF C.X) = .ANS_BUF C.X+1] ; 
0 Peat 8 ee 
: 311 % 1896 1 i Adjust Length of ANS_STRING 
: 318 m 1898 4 43 
; 14 a 189 1 ANS_STRING CDSC$W_LENGTH] = .ANS_STRING CDSCS$W_LENGTH) - 1 ; 
: 6 x 1831 1 END ; ! End FL macro 
; 31 1 é 1 Z; 
ci ee 
: $9 is ! ! The following tables convert the UNIT number into a logical name. 
; 32 1 3 1 MACRO 
: 2 1 3 1 DESC_(A) = UPLIT BYTE(ZASCIC A) = BASE 2; 
: fs 1 1 BIND 
é 5 1840 1 BASE = UPLIT(REP 0 OF (0)), 
i $26 1841 1 COB_TABLE = PLAT 
3 1 ri} 1 DESC_(*COBSINPUT*) 
; 38 1843 1 DESC™(*COBSOUTPUT'S 
: 329 1844 1 DESC ("COBSCONSOLE'S, 


| 


| 


m 4 
C ISPLAY VAX=11 COBOL DISPLAY statement 6-Sep-1984 AX-11 Bliss-32 V Page 7 
ro88 4-Sep-1984 1 93: tee 42 COBRTL.SRC coep  sPva B82; 31 n (2) 
5 0 1845 1 DESC_(* COBSCARDREADER') 
3 1 rk 1 DESC-(" COBSPAPERTAPEREADER'), 
; 1847 1 DESC_(*COBSLINEPRINTER'), 
: 1 rk 1 DESC_ (*COBSPAPERTAPEPUNCH')): VECTORCNUM_UNITSJ, 
4 1849 1 SYS_TABLE = uPL its 
3 5 1850 1 DESC_('SYSSINPUT') 
; 1851 1 DESC~("SYS$OUTPUT'S, 
5 1 26 1 DESC_('SYSSERROR'), 
3 8 1855 1 +343 Bt th 
; 9 1854 1 DESC_('SYSSINPUT' 
: 340 1855 1 DESC" (*SYS$OUTPUT' ‘5 
: 41 1837 ! DESC_("*SYSSOUTPUT' 5: VECTORCNUM_UNITS); 
3 rk 1858 1! | 
: 44 1859 1 ! EXTERNAL REFERENCES: 
; «345 1860 1! 
: 346 1861 1 EXTERNAL ROUTINE 
; 347 1866 1 LIBSSTOP : NOVALUE, ! Signals fatal error 
3 $05 1863 1 CIBSee P ' Get virtual memory 
; 349 1864 1 LIBSFREE_VM, Free virtual memory 
; 350 1865 1 STRSDUPL_CHAR, : ayes Seeve a chorecter n times 
3 $2 1866 1 STRSGET , ' Allocate a stri ng 
3 2¢ 1867 1 STRSFREET DX, ! Seat lecser a str ng 
3 3D 1868 1 TRSCOPY ' Copy a string by ref 
3 356 1869 1 COBSCNVOOT, ' Convert from D end F floating 
3 «Boe 1870 1 ' to Fortran E format 
3 336 1871 1 COBSCVTQP_R9 : CVT_JSB, ' Convert quad to packed 
3 Sor 1376 1 COBS$SETUP TERM TYPE, ' setup terminal type 
; $08 1873 1 COBSSSET_ATTRIBOTES ; ' Set old. reverse, blink, 
; 359 1874 (1 ! underline 
; 360 1875 1 EXTERNAL LITERAL 
: 361 376 «(1 COB$_ERRDURDIS, ! Error during DISPLAY 
; 362 377 1 _FAIGET_VM, ' Failure to get VM 
3 360 878 1 COB$_INVARG; ! Invalid Argument (s) 
3; 364 1879 1 
3 365 1880 1 EXTERNAL 
; 366 1881 1 COBSTERM_TYPE; ! Terminal type 


| Fi 
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GLOBAL ROUTINE COBSDISPLAY ( 

IT, ! Unit # of output device 
RING ! Input string 

NOVALUE = 


C200000D 
Poe 


02 09 0D CD 
WMruwTr 


lee 
' 


i FUNCTIONAL DESCRIPTION: 


Performs COBOL DISPLAY statement given a unit number and 

one or more strings to display. If more than one string is 
specified, these strings are concatenated into a single strin 
before being output. he vpspec ing to be employed is a function 
of this call (normal ADVANCING) and the u epec ie used on a 
preyious call to this routine or to COBSDISP_NO_AD 
OBSDISP_SCR, or COBSDISP_SCR_NO_ADV. 


V, or 


FORMAL PARAMETERS: 


UNIT. rl.v sateper unit number designating the device 
on which the string(s) is(are) to be displayed. 


STRING. rt.dx address of Ist of up to 254 string descriptors 
which are to concatenated and displayed on the 
specified device. 

IMPLICIT INPUTS: 


Status information as to whether the output file in question 
is currently open. 


IMPLICIT OUTPUTS: 

Updated status information for this file. 
ROUTINE VALUE: 

NONE 
SIDE EFFECTS: 


Outputs a record on the specified file. 


DOODOOOOO COO ODODOODOOOOODDDODDODODODOODOOOOOMwo 


APRITOTUNINININININIDN 4 2 3 2 St I = | “QOOCDOOCOCOCC OCOD OVOOOOOOMWMWWwo 


ee ed ee a ed el el el el el el el ee ee el lt el cl el el el cel el cl el cl el el el el el cel el cel ll cel cl el el cl cel cl cll cl cl cel els cll lls 


SPLIT a tt dd dt 


410 = 

411 BEGIN 

aig BUILTIN 

41 CALLG, 

ts 

416 COBS$AB_USPCODEL1) = CRR; ! Upspace code is carriage return 
417 CALLG(.AP, COMMON_CODE_15; 

418 COBS$AB_PREV(O) ="DISP? ! Prev. unit to become DISPLAY 
420 9 END; 


DISPLAY VAX=11 COBOL DISPLAY statement 
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COBSDISPLAY VAKk-11 COBOL DISPLAY statement 16-Sep-1984 00:02:31 Ak-11 Bliss=-32 V4.0-74 
eet o-808- 138s 00:08:35 COBRTL.SRCJCOBDISPLA.832;1 
«PSECT _.OBSDATA,NOEXE, PIC,2 
000000004 00000 COBSSAL _WAITE RAB: : 
LONG (7) 


0000# 0001C COBSSAW_WRITE_IFI:: 
«WORD C7) 


0002 “BLKB 
09# 00030 COBS$AB_PREV: : 
-BYTE 97) 


| 
| 
| 
| goose -BLKB 
002C COBSSAB_USPCODE:: 
-BLKB 
~-PSECT _COBSCODE,NOWRT, SHR, PIC,2 


00000 P.AAA: .BLKB 0 
54 55 50 4E 49 26 42 GF 43 09 00000 P.AAC: .ASCII <9>\COBSINPUT\ 
54 55 30 54 55 4F 26 42 4F 43 OA OOOOA P.AAD: ASCII <10>\COBSOUTPUT\ 
45 4c GF 5 4 4F 43 26 42 GF 43 OB 00015 P.AAE: ASCII <11>\COBSCONSOLE\ 
52 45 44 41 465 S2 44 52 41 43 26 42 GF & OF 00021 P.AAF: ASCII <14>\COBSCARDREADER\ 
52 45 50 41 54 52 45 50 41 50 : 4 af 43 13 000 0 P.AAG: .ASCII <19>\COBSPAPERTAPEREADER\ 
45 546 4E 49 52 SO 45 4E 49 4C 26 42 GF 43 OF 00044 P.AAH: .ASCII <15>\COBSLINEPRINTER\ 
50 45 50 41 54 52 45 50 41 50 26 42 4F 43 13 00054 P.AAL: ASCII <18>\COBSPAPERTAPEPUNCH\ 
I re ey 
00000044 00000030 00000021 00000015 0000000A 90000000 00068 P.AAB: .LONG 0, 10, 21, 33, 48, 68, 84 
54 55 50 4E 49 24 53 59 53 09 Sooke P.AAK: ASCII <9>\SYSSINPUT\ 
54 55 50 54 55 4F 24 33 59 53 OA OOOBE P.AAL: .ASCII <10>\SYS$OUTPUT\ 
52 4F 52 52 45 26 53 59 53 09 00099 P.AAM: ASCII <9>\SYSSERROR 
540655 «450 «(4E O49 «4 33 59 53 09 OO0A3 P.AAN: . ASCII <9>\SYSSINPUT\ 
54 55 «50 4E 49 246 53 59 53 09 OOOAD P.AAO: ASCII <9>\SYSSINPUT\ 
54 55 50 54 55 4F 24 53 59 53 OA 00087 P.AAP: ASCII <10>\SYSSOUTPUT\ 
54 655«(650 «(54 (O55 «(4k O24 «653 «59 «C53—COOA 900C2 P.AAQ ASCII £10>\SYSSOUTPUT\ 
00000087 O00000AD 000000A3 00000099 0000008E 00000084 000D0 P.AAJ: .LONG 132, 142, 153, 163, 173, 183, 194 
000000C2 O000E8 
BASE= P.AAA 
COB_TABLE= P.A 
SYS~TABLE= P.AAJ 
-EXTRN LIBSSTOP, LIBSGET_VM 
-EXTRN LIBSFREE_VM, STRSOUPL_CHAR 
SEXTRN STRSGETI-DX, STRSFREET_DX 
“EXTRN STRSCOPY"R, COBSCNVOU 
SEXTRN COBSCVTQP_R9, COBS$SETUP_TERM_TYPE 
EXTRN COBSS$SET ATTRIBUTES 
-EXTRN COBS_ERRDURDIS, COBS_FAIGET_VM 
-EXTRN COBS"INVARG, COBSTERA_TYPE 
0090 0000 ENTRY COBSDISPLAY Save nothing 
00000000" EF 8D «BF 0002 MOVB #115, COBS$AB_USPCODE+1 
0000v CF 6C FA OOOOA CALLG (AP), COMMON CODE_1 
00000000' EF 94 0000F CLRB  COBS$AB_PREV 


4 
ISPLAY ——-VAK=11 COBOL DISPLAY statement 16- Sep-1984 3 AX=11 Bliss-32 v4.0-74 p 0 | 
eet rn: gep-1986 ite en cote ha Pte oe age 19 | 


04 00015 RET 
; Routine Size: 22 bytes, Routine Base: _COBSCODE + OOEC 


————— 


F 4 
1 + jel VAX=11 COBOL DISPLAY statement Je~senn 1386 90:08 :3] AX-11 Oi legen Ye ,Oerae Page 11 
1-01 14-Sep-1984 12:10:42 COBRTL.SRCJCOBDISPLA.B52;1 (4) 
3; «6 ¢ 1935 1 GLOBAL ROUTINE COBSDISP_NO_ADV ( : 
; «6 19 § 1 UNIT, ! Unit # of output device 
> 424 19 1 STRING ! Input string 
> 425 1938 1 ) : NOVALUE = 
; 4 $ 1939 1 
3; 6 1940 1 !4¢ 
3 : : 13S) : : FUNCTIONAL DESCRIPTION: 
; 4350 1908 ,! Performs COBOL DISPLAY with NO ADVANCING statement given a unit number and 
> 431 1944 1! one or more strings to display. If more than one string is 
3 6 ; 1945 1! specified, these Strings are concatenated into a single —— 
; 4 1946 1! before be ne output. fhe upspacing to be employed is a function 
3 4 1947 1! of this call (NO ADVANCING )and the upseerin used on a 
> 435 1948 1! previous call to this routine or to COBSDISPLAY or COBSDISP_SCR, 
3 $38 1949 1! or COBSDISP_SCR_NO_ADV. 
; 437 1950 1! 
; 438 1951 1! 
> 439 1926 1 ! FORMAL PARAMETERS: 
3; 440 1953 1! f 
> 441 1954 1! UNIT.rl.v ae 4 04 unit number designating the device 
3 ey 133? : on which the string(s) is(are) to be displayed. 
> 444 1957 7 3 STRING. rt.dx address of ist of up to 254 string descriptors 
; 445 1958 1! which are to concatenated and displayed on the 
: 446 1959 1! specified device. 
3; 447 1960 1! 
: 448 1961 1 ! IMPLICIT INPUTS: 
: 449 1966 1! F ; p 
; 450 1965 1! Status information as to whether the output file in question 
> 6451 1964 1! is currently open. 
; «45 1965 1! 
: 45 1966 1 ! IMPLICIT OUTPUTS: 
3 454 1967 1! ; 2 
; 455 1968 1! Updated status information for this file. 
> 456 1969 1! 
: 457 1970 1 ! ROUTINE VALUE: 
: 458 1971 1! 
; 459 Hb 1! NONE 
: 460 1973 1! 
: 461 1974 1 ! SIDE EFFECTS: 
; 46 1975 1! ais : 
; 46 1976 1! Outputs a record on the specified file. 
> 464 1977 1! 
3; 465 1378 1 !-- 
: 466 197 BEGIN 
: 467 1980 BUILTIN 
; 468 1981 CALLG, 
; 469 1956 : 
; 470 198 
3; «471 1984 COBSSAB_USPCODE(1) = 0; ! Upspace code is 0 
3: 47 1985 CALLG(.AP, _CODE_1); é 
: 47 1986 COBS$AB_PREV([O] = DNA; ! Prev. unit to become DISPLAY_NO_ADV 
3 4674 1987 2 
3; «475 1988 1 END; 


SS Ss 


Fi 
ISPLAY _- VAK=11 COBOL DISPLAY statement 18-5 4 3 AX-11 Bliss-32 V Page 12 

408s Wr~Seo~ 188s P8982) | Perea T Ob lege se vEs0. 788. oe aS 
0000 .ENTRY COBSDISP NO ADY, Save nothin £1935. 

oo000000" EF $e a002 fire coBssAa OsPtopest 2 1984. 

0000V CF C FA 0000 CALLG | {AP). COMMON. CODE.1 : 1985. 

00000000" EF 1 90 0000D MOVB #1, COBSSAB_PREV : 1986) 

04 00014 ET : 1988 


; Routine Size: 21 bytes, Routine Base: _COBSCODE + 0102 


¢ ISPLAY VAX=-11 COBOL DISPLAY statement 16 t 1984 3 AX-11 Bliss-32 V4.0-74 S 13 
| — -sep- <Ud: a ss- ~VU= a 
ett 13-80 8=138e 90:08:25 COBRTL. Acoso sera B42. - (5) 

477 GLOBAL ROUTINE COBSDISP_SCR ( 

47 UNIT, ! Unit # of output device 

47 STRING, ! Input string 

480 FLAGS ! Screen enhancement flag 

. 1 nee ) : NOVALUE = 

4 : i FUNCTIONAL DESCRIPTION: 


Performs COBOL DISPLAY statement with screen enhancements. 
Given a unit number and one string to display using a flag that 
contains selected enhancements. 
A call to COBSPOS_ERASE is made by the VAX-11 COBOL Compiler 
prior to the call to COBSDISP_SCR to set cursor position and 
_—— 5 screen or Line erasing. 

h ng to be employed is a function of COBSPOS_ERASE and 


SS SSSSSFSE33 


e upspac 

the upspacing used on a previous call to this routine or to 
494 either COBSDISPLAY, COBSDISP_NO_ADV or COBSDISP_SCR_NO_ADV. 
496 
497 FORMAL PARAMETERS: 
498 


UNIT. rl.v entonye unit number Gostonating the device 
on which the string is to be displayed. 


STRING. rt.dx address of string descriptor which is to be 
displayed on the specified device. 


OOoooooooocoooo 
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ooovono 
“ Oo 
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04 

be FLAGS.rlu.v screen enhancement flag; 

07 bit 0 - bold 

08 bit 1 - reverse 

09 bit g - blinking 
0 bit * - underline 
0 bit 4 = bell 
0 bit 5 = conversion 
0 bit 6 =- decimal point is comma ; 
0 bit 7 = OQ print sign, 1 do not print sign 
3 bit 11 - 0 for VAX COBOL, 1 for VAX RPG 
0 
0 
0 


IMPLICIT INPUTS: 


Status information as to whether the output file in question 
is currently open. 


IMPLICIT OUTPUTS: 
Updated status information for this file. 
ROUTINE VALUE: 


RMNMNNINNNIN 4 
CSOCoCoO 


Temes os 
WN $0 OOVNOVEWN CO COBNOUSWN Oo 


NONE 
SIDE EFFECTS: 
Outputs a record on the specified file. 
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ISPLAY VAX=11 COBOL DISPLAY statement ibese -1984 00:02:3 AX-11 Oh iste -32 V4.0- Page 14 
it 122808- 1382 99:96:23 COBRTL. SRC ICOBDISPLA. 758251 ~~ 
; $ 1 !<< . | 
; 5 BEGIN 
; 8 BUILTIN 
; CALLG, 

: ; we 
; 540 § cpecese aysrcopery = CRR; ! Upspace code is carriage return 
3 (541 ALL G( COMMON. SCREEN); i Do common processing 
i 34 O54 COBSSAB. PPREVEO) =" ISP i Prev. unit to become DISPLAY 
: $44 056 END; ! end COBSDISP_SCR | 
| 
0000 00000 -ENTRY COBSDISP_SCR, Save nothing : 1989) 
00000000" EF 8D 8F 90 00002 vB 8-115, COB$SAB_USPCODE+1 3 $038 | 
0000v CF 6C FA OOOOA CALLG (AP), COMMO EEN 3 2053) 
00000000" EF 94 0000F CLRB  COBS$AB_PRE > 2054 
04 00015 RET : 2056 | 
; Routine Size: 22 bytes, Routine Base: _COBSCODE + 0117 


4 
OBSDISPLAY _- VAK=11 COBOL DISPLAY statement Ibese “1986 00:02:3 AX-11 Bliss-32 v4.0-74 p 5 
mitt aati e roe elt hd pe age 6) 


GLOBAL ROUTINE COBSDISP_SCR_NO_ADV ( 
P ! Unit # of output device 
STRING, ae string 


FLAGS creen enhancement flag 
) : NOVALUE = 


™ 
wn 
won 


lee 
! FUNCTIONAL DESCRIPTION: 


Performs COBOL DISPLAY NO ADVANCING statement with screen 
enhancements. Given a unit number and one string to display using 
a a that conte'ns selected enhancements. 

A gal to COBSPOS_ERASE is made by the VAX-11 COBOL Compiler 

prior to the call to COBSDISP_SCR_NO_ADV to set cursor position 


SeetsCTETe 


DPPPAASISIII 
BISARAN SS SUSE ALER IS SRSA EUS ome 


071 and perform ~ screen or Line erasing. 
ore The upspacing to be employed is a function of COBSPOS_ERASE and 
07 the upspec ing used on a previous call to this routine or to 
Bre either COBSDISPLAY, COBSDISP_NO_ADV or COBSDISP_SCR. 
O76 
144 FORMAL PARAMETERS: 
079 UNIT. rl.v Snteper unit number Gesignating the device 
$ oat on which the string is to be displayed. 
7 oes STRING. rt.dx address of string descriptor which is to be 
y oer displayed on the specified device. 
7 085 FLAGS. rlu.v screen enhancement flag; 
7 O36 bit 0 = bold 
7 08 bit 1 - reverse 
7 088 bit ¢ - blinking 
7 089 bit - underline 
79 090 bit 4 = bell 
80 091 bit 5 = conversion 
8 09 bit 6 = decimal point is comma 
8 bit 7? - print sign, 1 do not print sign 
8 bit 11 - 0 for VAX COBOL, 1 for VAX RPG 


3 


oo 
co~ 


IMPLICIT INPUTS: 
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23 


SV ah ab ah sb sb Ab Ab Ab Ab Ab Ab db Ab ib ib Ab Ab Ab Ab bbb bbb dh dbedb ah ab al slab ah als al 
QESRANLESELEAEAL= 
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1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
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1 
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1 
1 
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1 
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1 


099 Status information as to whether the output file in question 
130 is currently open. 
Ie IMPLICIT OUTPUTS: 
Hs: Updated status information for this file. 
1 ROUTINE VALUE: 
19 sh 
98 199 
99 110 SIDE EFFECTS: 
600 111 OR , 
601 Ng Outputs a record on the specified file. 
602 11 
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ISPLAY VAX-11 COBOL DISPLAY statement 16-Sep-1984 73 AX-11 Bliss-32 V4.0-74 Pa 16 
itt 14- at 1984 99: 95 i} COBRTL.SR aeicé OBDISPLA. 882; :1 - 
: 603 114 1 !<- 

F 115 BEGIN 
; 605 116 BUILTIN 
: 1 CALLG, 
: B 8 "i 
; $08 120 COBS$AB_USPCODEL1) = 0; ! Upspace code js 0. 
3 610 121 CALLG(.AP, C “SCREEN) ; i Do common processing 
: 611 - COBSS$AB_PREVLO] ="DNA; i Prev unit to become DISPLAY_NO_ADV 
; gig 124 END; ! end COBSDISP_SCR_NO_ADV 
0000 00000 sENTRY COBSDISP_SCR_NO_ADV, Save nothing ; 2057) 
00000000" EF 94 002 CLRB COB OBSSAB OSPCOp he + 2120 
0000v CF 6C FA 000 CALLG COMMON. S : 121, 
00000000" EF 07 90 0000D MOVE » tonss SAB_ PRE + 2122 
04 00014 RET > 2126 | 


; Routine Size: 21 bytes, Routine Base: _COBSCODE + 012D 


4 
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; $1? } i } ROUTINE COMMON_CODE_1 (UNIT, STRING): NOVALUE = 

: 61 ler 1: 

3 3h : 8 : FUNCTIONAL DESCRIPTION: 

; 6 130 1! Performs common part of DISPLAY and DISPLAY_NO_ADV processing. 

: 8S 132 4 i 

; 6 § : | FORMAL PARAMETERS: 

3 625 135 1! UNIT. rl.v integer unit number designating the device 

3 ° $ } : on which the string(s) is(are) to be displayed. | 
5 628 138 1 STRING. rt.dx address of Ist of up to 254 string descriptors 
; 629 139 1! which are to concatenated and displayed on the 
; 2 : vat : } specified device. 
: 6 142 1 | IMPLICIT INPUTS: | 
; 6 143 13 | 
; 634 144 1! Status information as to whether the output file in question 

5 ? 5 13? ; is currently open. 

; 637 147 { IMPLICIT OUTPUTS: | 
; 659 149 1 | Updated status information for this file. | 
: 641 131 i ROUTINE VALUE: 

Bee eee os 

; 645 135 i SIDE EFFECTS: | 
> 647 133 1 Outputs a record on the specified file. 

: BS 138 3 BEGIN 

: 650 160 BUILTIN 

; 651 161 ACTUALPARAMETER, 

3 636 166 ACTUALCOUNT; 

> 654 164 LOCAL 

; 655 165 TEMP VECTOR CCOBSK_DIS_SIZE,BYTEJ, ! Temp buffer on stack 

; 656 166 ' Total chars to output 

3; 657 167 ADDR, ! Pointer into allocated storage 

; 658 168 STATUS, ! Status from LIBSGET_VM call 

; 659 169 DESC: BLOCK (C8,BYTE); ' Dynamical ly constructed desc. 

; 660 170 ! for concatenating strings 

Bo a 

; oss 178 : If there is only one item to display, write directly from caller's buffer 

: 665 175 if ACTUALCOUNT () EQL 2 

3, 7 BEGIN 

; 668 178 COMMON_CODE(.UNIT, .STRING); ! Do common processing 

3 068 17 RETURN; 

; 670 199 END; 

3; 671 181 


Be Se Se Se Se Be Se Ge Se Be Se Be Fe Ge Ge Ge Se Se Se Ge Fe Ge Se Se Ge Ge Se Ge Se Se Gs Se Se Ge Ss Se Se Ge FHSS Se Se Se Se Ge Se Ge Se Se ee Se Se Sete Ge Seas 


ee 


67 
#: 
ore 


67 
67 


= 


710 


AORN Rom a st tt eee 
DWNOVEWN CO OONOUSWN— 


7 
7 
7? 
7 
7? 
7? 
7? 
7? 
4 
7 
7 
7 
7 
7 
? 
7 
7 
7. 
7 


Rofonoronys 


VAX-11 COBOL DISPLAY statement 
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Mm 4 
Weeb- 1986 $ossbsae — EeOaRtL sre 
Count total text to be displayed 


COUNT = 0; 
INCR I FROM 2 TO ACTUALCOUNT() DO 
COUNT = .COUNT + .BLOCKE ACTUALPARAMETER(.1), DSCSW_LENGTH; , /SYTE); 


eo 
=< 
| 
m 
va) 
~ 
= 
=) 


$A_ 


3 !' Assume stack is used 


: Fyreptonete the caller's $ string(s) into a single ety 
! If there are more than ‘‘COBSK_DIS_SIZE"’ characters to be displayed, 
i allocate heap storage -- else use the stack. 
if .COUNT GTR COBSK_DIS_SIZE 
THEN 
BEGIN 
; Allocate space and store its address into descriptor 
if NOT (STATUS = LIBSGET_VM(COUNT, DESCCDSCS$A_POINTER))) 
. LIBSSTOP(COBS_FAIGET_VM, 0, .STATUS); 
ADDR = .DESCCDSCSA_POINTER); 
INCR I FROM 2 TO ACTUALCOUNT() DO 
BEGIN 


PTR: REF ett P thay 
PTR = ACT UALP 


R(.1); 
CHSMOVE (. PrREDSCSu IreNGt gPTRCDSCSA_POINTER], ADDR); 
ADDR = .ADDR + .PTREDSC$W_LENGTHI; 


DESCCDSCS$W_LENGTH] = .ADDR - .DESCCOSCSA_POINTER); 


COMMON_CODE(.UNIT, DESC); ! Do common processing 


: If we've been using heap storage, give it back 
if COUNT GTR COBSK_DIS_SIZE 
LIBSFREE_VM(COUNT, .DESCCDSCSA_POINTER)); 


conse iSPLAY 


729 


; Routine Size: 


VAX=11 COBOL DISPLAY statement 


2239 1 


F2 


END; 


0000v 


04 
08 
00000084 


000000006 


~ 000000006 


172 bytes, 


04 


0000V 
00000084 


000000006 


Routine Base: 
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00 


FF70 


010E0000 
oc 


000000006 
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_COBSCODE 


ISoseoct9ge 99:03: 


O3FC 00000 CORON SORE 1: 


+ 


4 000 
G B08 
i Sa 
B O016 
04 0001 
4 Bei8 1$: 
A 0001 
DO 00018 
11 itt 
0 4 28: 
C 00024 
£0 B88 7 
F3 0002A 3$: 
dO 4 E 
9E 000 
01 00038 
15 00042 
9F 00044 
9F 00047 
4 Q004A 
E8 00051 
DD Bade 
D4 00056 
PB OOOSE 
06 00088 4$: 
A 00069 
DO 0006C 
11 it 
0° 00071 5$: 
¢ se fe 
C OO07A 
C 44) 
4 0080 6$: 
$F OOOBA 
DD 00080 
FB 00090 
Di 00095 
15 0009C 
pp +41 
F OOOA 
FB QOOA4 
04 OOOAB 7$ 
0142 


th Hebant ste sche ee b82. 1 


Save R2,R3,R4,R5,R6,R7,RB,RI 
=144(SP), §P 


UNIT, =(SP) 
#2, COMMON_CODE 


$ 
#17694720, DESC 
TEMP DES +4 
count, #132 
DESC+4 
“i 1BSGET _vM 
Hint 
Ll 
seh FAIGET _vM 
sett tt 
P), RO 
i 
$° 
AP)C 
PTRD. om. (ADDR) 
PTR) 


Bite *ADoR, DESC 


Nit 
a. fOnmon, CODE 
COUN #132 

$ 

DESC+4 

COUNT 

#2, LIBSFREE_VM 


ree 8 
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C ISPLAY VAX=11 COBOL DISPLAY statement ib-se =1984 00:02:31 AX-11 Bliss-32 V4.0-74 Page 20 
itt 1a-sep-19 4 90:08:25 COBRTL. RCICOBDISPLA.B 2;1 ° BS 


: i 1 re } ROUTINE COMMON_CODE (UNIT, STRING): NOVALUE = 

: 7 : 4g 1 !+6 

: 4 ¢ tz : } FUNCTIONAL DESCRIPTION: 

: 7 45 1 Performs processing which is common to both DISPLAY and 
ee ‘8 1! tte a WITH NO ADVANCING. 

> 738 47 1! consisting of: 

; 739 $3 1! Open unit if currently not open 

; 740 49 1! Complete calculation of upspace code 

; ot) 29 : } Writes out the string 

: is ag fi 

; 245 24 | FORMAL PARAMETERS: 

: 747 36 1 i UNIT. lev integer unit number designating the device 
3 ae 2 : on which the string(s) is(are) to be displayed. 
: 750 59 1: STRING.rt.dx address of descriptor for the concatenated 
: r2) soo : strings. 

: 738 26g { IMPLICIT INPUTS: 

: 755 2264 1 | Status information as to whether the output file in question 
: £38 2266 : } is currently open. 

: 738 367 { IMPLICIT OUTPUTS: 

: 760 $508 1: Updated status information for this file. 

3; 761 2270 1! 

; 76 2271 +1 ! ROUTINE VALUE: 

s 76 ssi¢ 1! 

: ree $si7 : NONE 

oe 278 1 | SIDE EFFECTS: 

> 767 re 1} lal ® 

: re8 $f : : Outputs a record on the specified file. 

: 770 $78 1 ie- 

s 771 280 BEGIN 

; 77 $B MAP 

oe S STRING: REF BLOCK(8, BYTE); 

3; 774 $3 

3 775 4 LOCAL 

: 776 3H FILE_NAME : BLOCK (8,BYTE), ! dynamically constructed desc. 
3 777 a6 RAB: REF $SRAB_DECL; 

: 778 8 

3; 6fy 88 LITERAL as 

3 rm 4 INIT VALUE = 9 ; ! Initial COBSS$AB_PREV value 
; 78 331 IF .UNIT GTRU COBSK_UNIT_MAX 

3 2 38 LIBSSTOP(COBS_INVARG) ; 

: Be 38 

> 787 96 ! If file is not yet open, open it. 


1984 99: tee :42 CbaRTLe sR tic abo! feraB 2;1 a B) 


5 
iC ISPLAY VAX=11 COBOL DISPLAY statement 
ett 16-s 38: 


: 7R8 4 iF .COBSSAL_WRITE_RABL.UNIT) EOL 0 

: 79 01 i Second parameter of 0 signifies that COBSSOPEN_OUT is called on 

: et 8 behave of VAX COBOL. 

: 795 04 COBSSOPEN_OUT(.UNIT, 0); 

; 796 05 = 

s 797 06 

; 798 07 : Calculate the upspacing codes needed to use on this action 

; 64 8 If previous operation was a DISPLAY, a Line-feed is needed 

: 801 10 COBS$AB_USPCODELO) = 0; 

; 80 11 IF .COBS$AB_PREVCO] EQL DISP OR .COBS$SAB_PREVCO] EQL POS OR  .COBSSAB PREVE OI EQL ACC_ADV 
; 80 \¢ OR .COBSS$AB_PREVCO] EQL INIT_VALU 
: $05 12 — COBS$AB_USPCODECO] = LINE_FEED; 

3 806 315 

; 807 318 

: +4 + Write out the concatenated rth 

: 810 19 RAB = .COBSSA _WRITE RABE UNI 

> 811 20 RABER ABSL L ABP )"= STRING BSCSA TgointER): 

: ois 35! RABCRAB$W_RSZ :STRING DSC$W_ LENGTH); 

: B14 308 : 

: Bie $e Write the record. Retry certain errors, signal others. 

3 a7 3396 ; WHILE SPUT(RAB = .RAB) EQL RMS$_RSA DO SWAIT(RAB = .RAB); 

: B19 2328 

; 320 $309 IF NOT .RABCRABSL_STS) 

; B22 2331 é LIBSSTOP(COBS$_ERRDURDIS, 1, .RAB+RABSC_BLN, .RABCRABSL_STSJ, .RABCRABSL_STV)); 
: B24 $335 1 END; 


-EXTRN SYSS$PUT, SYSSWAIT 
001C 00000 COMMON_CODE: 
WORD 


. Save R2,R3 ‘ ; 2240 
54 900000006 00 9€ 0000 MOVAB LIBSSTOP, : 
53 00000000' EF 9€ 000 MOV EOBSSAL Pari te _RAB, R3 : 
3E 08 C2 000 SUBL sp ; | 
5 04 AC 00 0001 MOVL UNIT, R2 > 2291. 
06 52 D1 0001 CMPL Re. 6 ; | 
09 1B OOO1A BLEQU 1 ; 
000000006 er DD 0001 PUSHL #OBS, INVARG > 2293 
4 1 FB 000 CALLS L TBS : 
6342 p 0025 1$ TSTL Coés AL sORITE _RABLR2) > 2298 
9 00 BNEQ : 
D4 O002A CLRL = (SP) > 2304. 
52 DD 000ec PUSHL Re : 
0000v CF 02 FB 0002E CALLS #2, COBSSOPEN_OUT : 


— 
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; Routine Size: 


VAX=11 COBOL DISPLAY statement 


149 bytes, 
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50 $5 a3 
02 
A 
04 g 
. i 

2c )hCOU A 8A $F 

5 6342 
5 8 ag 

5 uh 4 A 
2s $9 
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| COBSDISPLAY VAX=11 COBOL DISPLAY statement ibese -1984 00:02:31 AX-11 Bliss-32 V4.0-74 Page 23 { 
Rett: 12-808-1 3b. 99:0 742 COBRTL. RCICOBDISPLA.B 2;1 . (33 | 
: $ ¢ : GLOBAL ROUTINE COBSSOPEN_OUT (UNIT, RPG): NOVALUE = 
: 828 g 1 te 
; 4 2 8 : : FUNCTIONAL DESCRIPTION: 
: 8 1 3 Open a file for writing, given a unit number. i 
: 8 g 41 1 | FORMAL PARAMETERS: | 
: 835 rk 1: UNIT. rl.v integer unit number designating the device i 
; $39 rf: : on which the string(s) is(are) to be displayed. i 
; $34 46 1: RPG. rl.v = 1 if COBSSOPEN_OUT called for VAX RPG 
: $78 rt : } = 0 if COBSSOPEN_OUT called for VAX COBOL 
: 841 49 1°! IMPLICIT INPUTS: 
3 Hh 50 1! i 
3; «684 7 oS NONE i 
: 844 326 1! : 
; 845 35 1 ! IMPLICIT OUTPUTS: i 
; 846 2354 1! i 
: 847 $322 1! NONE i 
; 848 356 1! i 
; 849 S325 1 ! ROUTINE VALUE: i 
; 850 358 1! j 
3; 851 $325 1! NONE ‘ 
3 $26 360 1! ; 
s §> $30) 1 ! SIDE EFFECTS: i 
; 854 306 1} eer i 
3 855 2365 1! Opens a file. On error, Signals a fatal condition. ‘ 
3; 856 Seee 7. % i 
3 857 365 1 !-- | 
; 858 2366 1 j 
; 859 2367 BEGIN | 
; 860 2368 LITERAL i 
; 861 2369 _BUF = MAX(64, NAMSC_MAXRSS); i 
; 306 $3r0 § LOCAL 3 
: 86 371 3 SFAB_DECL, H 
: 864 $378 2 NAM: SNAM_DECL, i 
3 865 237 3 RAB: REF SRAB_DECL ; : 
; 866 2374 FILE_NAME: eerie y BYTE), ! Descriptor for the file name j 
: 867 $37? TRANSLATE: BLOCK(8, BYTE i 
; 868 76 P: REF VECTORL, BYTE) : 
; 869 327 RSLBUF : VECTORCMAX_BUF BYTE), ; 
; 870 78 STATUS; i 
1. oa : 
; B75 381 ! Determine whether the COBS$xxx name is defined. i 
; are 358 If so, use it. If not, use the corresponding SYS$xxx name. i 
: 876 84 TRANSLATECDSC$B_DTYPE] = DSCSK_DTYPE_T; i 
3; 877 5 TRANSLATECDSC$B_CLASS = DSCSK_CLASS_S; i 
; 878 86 TRANSLATECDSCSW_LENGTH) = MAX 3 { 
3 14 Hi TRANSLATECDSCS$A_POINTER) = RSLBUF; i 
: 881 89 '¢ 
; 882 90 ! If VAX RPG is calling this routine, bypass COB_TABLE. i 
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5 
ISPLAY VAX-11 COBOL DISPLAY statement iSese -1984 00:02:31 AX-11 Bliss-32 V4.0-74 Pa 5 
itt ease} 98e 99:98:23 | HeMen tthe casa yearn 6S2.1 oe 83 
; 940 44 
: 941 cs IF NOT (STATUS = LIBSGET_VM(ZREF(RABSC_BLN + 8 + .NAMCNAMSB_RSLJ), RAB)) 
; 308 451 LIBSSTOP(COBS_FAIGET_VM, 0, .STATUS); 
. 
: re 454 ! Save a descriptor for the resultant file name string, 
3 Se 36 : and the string itself, after the RAB 
: 9% 4 5 BEGIN 
; 950 458 LOCAL 
: 991 45 Q: REF BLOCKC,BYTE); 
; 9 é 460 Q = .RAB + RABSC_BLN; 
: 95 461 QCDSC$B_DTYPE) “= DSC$K_DTYPE_T; 
: 954 46 QCDSCSB-CLASS] = DSCSK CLASS S; 
FRESE ESRBSERRCRENGTnn, > Teams TEES tence 
P =. 4 
; 9e9 465 CHSMOVET .QCDSCSW_LENGTHJ, .TRANSLATECDSCSA_POINTER], .RAB+RABSC_BLN+B ); 
; 958 466 END; 
; 959 46 
; 960 468 
: 961 P 2469 SRAB_INIT( 
: 96¢ P 2470 RAB = .RAB, 
; 96 P 2671 FAB = FAB, 
: 964 P 247 ROP = EOF 
; 965 47 RHB = COB$S$AB_USPCODE); 
; 966 474 
3 967 475 Lf NOT SCONNECT(RAB = .RAB) 
; 44 rh 44 LIBSSTOP(COBS_ERRDURDIS, 1, .RAB+RABSC_BLN, .RABCRABSL_STS], .RABCRABSL_STVJ); 
: 971 479 COBSS$AL_WRITE_RABC.UNIT) = .RAB: 
; 97@ 480 COBS$AW_WRITE-IFIC.UNIT] = .FABLFABSW_IFI); 
: 97 481 1 END; ! end of COBSSOPEN_OUT 
.EXTRN SYSSTRNLOG, SYSSCREATE 
SEXTRN SYSSCONNECT 
OFFC 00000 ENTRY COBSSOPEN OUT, Save R2,R3,R4,R5,RO,R7.R8,~ 2334, 
aR 000000006 60 SE 99009 ROVAB — COBSSAB_USPCQOE, RIT pet 
2 E38 ce 9 09016 MOVAB = 3 (SP); SP : 
CD 00F F p 01 MOVL #17694975, TRANSLATE > 2386. 
gp 08 AE O1E MOVAB RSLBUF, TRANSLATE+4 ; é 87 | 
8 AC 06 09 4 MOVL UNIT, R > 2396 | 
58 02 0028 ASHL #2, RB, R7 ; | 
01 aC D4 00 CPL RPG, al > 2393 
CF 9€ 80 MOVAB BASE, RO > 2402. 
FDA9 CF47 OF 90 PUSHAB COB fABLECR7) ; 
9E C1 C ADDL3 a(SP)+, RO, P ; | 
8F 60 9040 MOVW #270, FILE NAME+2 > 240 
62 98 04 MOVZ7BW (P) AME > 240 
A2 9E 0004C MOVAB 1(R2), FICE_NAME+4 > 2406 
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72:96:22 EtOant. *SaeScosolseca.682; 1 


5), FI 
0, (§P), 


#20483 ~— 


PTR 
#64, SRMS_PTR+ 


SRMS_PTR+40 


FILE_NAME?4, SRMS_PTR+44 
§ R+52 


ILE NAME, SRMS 


F ‘ F 
#0, TSP), #0, #96, SRMS_PTR 


#24578, SRMS_PTR 
#1, SRMS_PTRF2 
RSLBUF, SRMS_PTR+4 
#1, $RMS_PTR710 
RSLBUF , SRMS_PTR+12 


#1, SYSSCREATE 

RO, ga 

NAM+5, TRANSLATE 
ert. TRANSLATE 
FAB+52, TRANSLATE 
FAB+44, TRANSLATE+4 
STATUS, 4 

FAB+8, -(SP) 
[OALATE 


gcoBs ERRDURDIS 
#5, LIBSSTOP 


NAM+3, 4(SP) 
#76, 4(SP) 
4(SP) 


4% LIBSGET_VM 
RO, STATUS 
STATUS, 5$ 
STATUS 

#coBs FAIGET_VM 
#3, LIBSSTOP 


RAB, R6 
68(R6), RO 


NAME 
CE wa: 
#0, #80, SRMS_PTR 


roe 


2407 


2451 


2460 
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1 4 :02:5 Pp 7 
| eats TT ee thet Ts ft oe aoe gf 
5 9 D 153 MOVL R9, @ ; 
02 A 0106 a 89 136 MOVW #270, 2(0) + 2461. 
6 FF40 «6 CD 1 ; MOVW TRANSLATE, (Q) + 2463. 
rt a Free DD me 5 186 novcs ut atRANSL ATES 76(R6) : reed 
00464 af § 6E 6 C D MOVCS #0, (SP), #0, #68. (R6) : rid 
66 4401 er 0 00175 MOVW #17409, (R6) : | 
4 Ab 0100 =F 3c 17A MOVZWL 4256 4cr : 
C Ab 68 9€ 001 VAB coBs$aB USPCODE, 44(R6) F 
Oe 8 Bie cae poe ote tours 
000000006 00 if Fe 61 CALLS #1, SYSSCONNECT ; | 
11 0 E 01 BLBS RO, 6 : 
7E 08 Ag D 0019 MOVQ 8(R6), -(SP) + 2477. 
59 DD 00199 PUSHL R9 : 
01 DD 00198 PUSHL #1 ; 
000000006 8F DD 9190 PUSHL #coBs ERRDURDIS ; | 
6A 05 FB OOIA CALLS #5, LTBS$STOP ; 
D4 AB47? 9F OOIAG 6S PUSHAB COBSS$AL_WRITE_RABLR7J 3 2479) 
9 56 DO OOTAA MOVL RG, + : 
FO AB4 B2 AD BO 001AD MOVW  FAB+2, COBSSAW_WRITE_IFICR8] > 2480) 
04 00183 RET ; 2481 | 
; Routine Size: 436 bytes, Routine Base: _COBSCODE + 0283 
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975 ¢ ROUTINE COMMON_SCREEN ( ! Common processing 

97 UNIT, i Unit # of output device 
97 STRING : REF BLOCK (8,BYTE), | fond string 

97 5 FLAGS i Screen enhancement flag 
5 ): NOVALUE = 
$81 'ee 

¢ ' FUNCTIONAL DESCRIPTION: 

Bz Performs 5 OER RS ADE. which is common to both COBSDISP_SCR and 

985 COBSDISP 

86 This 1eP todes : 
9 Comp unit if currently not open 

88 + lete colcuretion of bit ace code 

989 ‘8 ti sonyers ren on routt ee DISP_CONVERT 

a 


Call COBSSSET ATTRA BOT tes. 
Write out the ‘eaten 
FORMAL PARAMETERS: 


UNIT. rl.v integer unit number Ges ignating the device 
on which the string is to be displayed. 


STRING. rt.dx address of string descriptor which is to be 
displayed on the specified device. 


FLAGS.rlu.v screen enhancement flag; 
bit 0 =- bold 
bit 1 = reverse 
bit ¢ - blinking | 
bit - underline 
bit 4 = bell 
bit 5 = conversion 
bit 6 = decimal point {s comm 
bit 7 =- 0O print sign do oat ty sign 
bit 11 - 0O for VAX O80L.. 4 for VAX RPG 


IMPLICIT INPUTS: 


Status information as to whether the output file in question 
is currently open. 


IMPLICIT OUTPUTS: 

Updated status information for this file. 
ROUTINE VALUE: 

NONE 
SIDE EFFECTS: 

Outputs a record on the specified file. 
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3 oe 
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> 1007 
> 1008 
> 1009 
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RELLRLPLSCALS SOS 


9 } I< 
BEGIN 


UILTIN 
ACTUALPARAMETER, 
ACTUALCOUNT ; 


! a Line-feed is needed. 


COBS$AB_USPCODEL 
IF .COBS$AB_PREV 


THE 


0) = 0; 
CO] EQL DISP OR .COBSSAB_PREVCO) EQL POS OR _ .COBSSAB_PREVCO) EQL ACC_ADV 
OR .COBSSAB_PREVCO] EQL INIT_VALUE 


N 
COBS$AB_USPCODECO) = LINE_FEED; 


3 3 

3 3 4 

3 3 4 

3 d 

t i 

31 46 LOCAL 

31 4 ANS_STRING BLOCK cS Bytes. ! Descriptor for cutout 

3 Y ‘3 PUT_FLAG INITIAL (0) ' Longword flag for $PUT 
:1 4 FAB REF $FAB_DECL, i Fab for output device 
3 1 2 0 RAB REF a DECL, ! Rab for output device 

3 1 1 OUT_BUF VECTOR CCOBSK_ACC_SIZE,BYTEJ, ! Buffer passed to 

3 1% 5 § ' COBSSSET_ATTRIBUTES 

F} ; 2 z OUT_LEN : INITIAL (0) ; ! Passed to COBSSSET_ATTRIBUTES 
: 1048 555 LITERAL | 
3 228 INIT_VALUE = 9 ; ! Initial COBSSAB_PREV value 
: i080 325 r 

; 1926 559 i There should be no more than 3 parameters 

3; 105 560 !- 

3 1054 561 

; 1055 206 IF ACTUALCOUNT() GTR 3 

; 1938 56 

3; 105 564 LIBSSTOP(COBS_INVARG) ; 

: 1058 565 

§ 4 IF .UNIT GTRU COBSK_UNIT_MAX 

> 1061 568 LIBSSTOP(COBS_INVARG) ; 

Me | BRB, 

: 1064 571 i If file is not yet open, open it. 

Bie Ba po 

F 106? 57% IF .COBSSAL_WRITE_RABLC.UNIT) EQL 0 

3 1908 37? THEN 

; 109 358 i Second porene ter tells COBSSOPEN_OUT whether VAX COBOL (0) 

3 34 378 : or VAX RPG (1) is the caller. 

; $78 580 COBSSOPEN_OUT ( .UNIT, 

3 or 581 en gTLAGs AND V_COB_RPG ) NEQ 0 

3 O76 588 ss ELSE O) ; 

: he | 5 i Calculate the upspacing codes we need to use on this action. 

3 ! If previous operation was a DISPLAY (COBSDISPLAY or COBSDISP_SCR), 

; 88 

3 +) 

3 90 

; +4 

; 38 

3 94 

3 95 
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ISPLAY VAX-11 COBOL DISPLAY statement 18-5 


i ! 


3 


es of input 


Create descriptor ~ STRING. ALL TYPEs and CLASS 

T through conversion 
l 
l 


' 

: LAS 
! string descriptors will eventually be deposited ( 
! and parsing) into ANS_STRING for output. 

! Because STRSCOPY_R is used ther need to allocate and 
ill do this. 


e is no 
deallocate space for ANS_STRING as STRSCOPY_R w 


SSeFSFSSESS 


6 

6 ANS_STRING [DSCSW_LENGTH] = 0; 

6 ANS-STRING DS¢$B-DT¥PEd = DSCSK_DTYPE_T ; 

6 ANS-STRING [DSCSB-CLASS] _ = DSCSK“CLASS-D : 
ANS-STRING CDSCSA“POINTER] = 0 ; 


i Check FLAGS parameter. If conversion requested (bit 5), 
! call routine to convert and parse the various data types. 
Convert all data types to Text. 


PAAAGAOAAD 
tt 4 ss ss sO 


o 
* 


IF (€ .FLAGS AND V_CONV ) NEQ 0 
THEN DISP_CONVERT ( .STRING, .FLAGS, ANS_STRING ) 


: This will handle TEXT without CONVERSION and anything else 

! without conversion. 

! Note - if user does not request conversion for any data byes 
{the string will be output as is (same results as old DISPLAYS 


ELSE 
IF NOT (STRSCOPY_R ( ANS_STRING, STRINGCDSC$W_LENGTH] 


~STRING CDSC$A_POINTER] )) 
THEN LIBSSTOP (COBS_ERRDURDIS) ; 


'¢ 

! Conversion and Parsing completed (if requested) - Btept ey string. 
Break down FLAGS parameter tg a valid parameter for $PUT. 

! (ie. the first four bits (0-3) of FLAGS parameter are passed to $PUT) 

! Determine whether or not to ring terminal bell (bit 4). 


PUT_FLAG = .FLAGS AND FLAG MASK ; 
os -FLAGS AND V_BELL ) NEG 0 


WAAL POPOPOPoRPORonon 


PMOTIPONIPENOPONONY 2 OOOO oO 


RAEAEXRAEAAA AAA AAA AAA AAAAA AOS 


Www 


BEGIN 
OUT_BUFCOJ = BELL ; 
QUT-LEN = .OUT_LEN + 1 ; 


' 
! Request for bold, reverse, blinking, underline, or any combination 
i thereof. It is first necessary to determine terminal ty e. 

! COBSSSETVP_TERM_TYPE puts this information in COBSTERM_TYPE. 

' Call COBSSSeT_ATTRIBUTES to turn on requested terminal attributes. 
! After call OUT_BUF contains concatenation of - 

: bell sequence, if requested 

: escape sequence to turn on attributes, 


a a mk ke a ek ak ed td ds od td = a a 2 a 


bababadbatad batatiadadbdabdaaadtaatataadoiadadabdadiadadaiaaubababiabababababdababababadad 
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; 1346 6 ; ! nee B 7 bi Pig my wares to be iEiselaves. and 

3 114 ' turn off attrib 

5 1368 5 : th e ogated. oe foBssses ATTRIBUTES. 

3 116 6 § ' obas SET ‘Ry IBUTES is called éven if no terminal attributes 

3 + ? : } are requested to copy ANS_STRING to OUT_BUF. 

: 11 65 

ve 660 RAB = .COBSSAL_WRITE_RAB C. UNITI; 

: 11546 661 IF COB STERM_TYPE EQC 0 ! If terminal type not 
3; 1155 666 THEN ! yet determined 
3 1128 66 BEGIN 

3 We $80 LOCAL 

3; 1158 5 NAM_DSC : REF BLOCK C,BYTE) ; ! e dsc (from 

3; 1159 286 ' COBSSOPEN, our) 
; 1160 66 .RAB + RAB 

3; 1161 668 4 IF Trapt (  COBSSSETUP. TERRE Ut vee ( .NAM_DSC PostsA. POINTER], 

3 1306 669 4 »NAM-DSC DSC$W_LENGTH), 

; 116 670 4 COBSTERM_ TYPE ) ) 

: MB ¢: of) THEN LIBSSTOP (COBS_ERRDURDIS) ; 

; 1196 e78 IF .COBSTERM_TYPE EQL UNKNOWN 

3 4 of? COBSTERM_TYPE = vT100; ! treat file as vT100 

: 1% $f END 2 

3 1178 678 IF NOT ( COBSSSET_ATTRIBUTES ( eo ith TYPE, .ANS i CDOSC$A_POINTER], 
3 117 680 S_STRING COSCSW LENG -PUT_FCAG, 
3 1174 681 T gure}: OuT “TER 

: 1175 ors e THEN LIBSSTOP (COBS_ERRDURDIS) - 

: 1176 68 

3; 1177 684 '+ 

; 1178 685 ! Put OUT_BUF in RAB 

3 1179 68 !- 

; 1180 68 

3: 1181 688 RAB CRABSL_RBFJ] = OUT_BUF C0) ; 

: 4 689 RAB CRABSW_RSZ) = .OUT_LEN ; 

3: 118 690 

> 1184 691 ‘6 

3; 1185 69 ! Display the final form of the original input string. 

1189 $94 di 

: HB O44 WHILE SPUT(RAB = .RAB) EQL RMSS_RSA DO SWAIT(RAB = .RAB) ; 

; 1190 63 IF NOT .RAB CRABSL_STS) 

: 1138 699 LIBSSTOP (COBS_ERRDURDIS . RAB+RABSC BLN, -RABCRABSL_STSJ, 

7 119 700 Ss aBtRABSe _STV])"; 

3 1194 701 

: 1195 702 END ; ! end COMMON_SCREEN 


1F MMON_ SCREEN: 
ne ' WORD. Save R2,R3,R4,R5,R6,R7,R8 : 2482. 


cons ISPLAY 


04 oc 
FDEF 
2c 
F8 
OF oc 
0000Vv 
000000006 
53 oc AC 
06 of 
4 


AD 


VAX-11 COBOL DISPLAY statement 


0 : 4 
01 
046 =A 
01 
654 
13 
08 
4 
2 
? 
5 
0 
¢f A 
0 AS 
OF 
50 
OA 
50 
05 
50 
05 
8A BF 
020E0000 8F 
FC AD 
08 AG 
0 
F8 AD 
oc OA 
5 
0 
1 
04 Ad 
F8 
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35-1986 
ep-1 


$: MOVL 
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1986 92:96: 


=32 V4.0-74 
COBDISPLA.B 


pais 


AX-11 Bliss 
COBRTL tt | 
_INVARG, R8 
“ERRDURBIS 
TYPE, age” 
L ,ORITE. “RAB, RS 
Seat SP 
AG 


oDo@ 


—e 
ow 


R 
#1, LIB$STOP 
UNIT, R 

R2, 6 

2$ 


#1, LIBSSTOP 

COBSSAL_URITE_RABLR2] 

#11, FLAGS, 3$ 

Tl 

4$ 

-(SP) 
#5 

’ COBSSOPEN OUT 
COBS$AB_USPCOBE 

‘OB BSSAB~ PREV. RO 

RO, #2 

6$ 

RO. rT 

65 

RO, rT) 


5 sy att USPCODE 
#344 {9 6 ANS STRING 


eTaTN Ace Inges 
#5, FLAGS, 8$ 
Ang TRING 
i 
. DISP_CONVERT 
4(RO) 
RO 


ANS_STRING 
#3,” SIRSCOPY. YR 


#1, LIBSSTOP 


#0. #4, FLAGS, PUT_FLAG 
#4. FLAGS, 10$ 
7 OUT_BUF 


OUT _LEN 
COBSSAL WRITE_RABCR2], RAB 
COBSTERA_TYPE™ 
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C ISPLAY VAX=11 COBOL DISPLAY statement 1b-50 -1984 :02:3 AX-11 Bliss-32 V4.0-74 Page 33 
ett 12-8 08- 1 3be 90:08:33 YCOBRTL SRE COBDISPLA.B32;1 ° 183 
22 12 000cB BNEQ 12% ; 
50 44 Ae OE Bc MOVAB Mgtn2), NAM_DSC + 2667 
5 pb DY PUSHL R6 : 2668 
7E 60 3¢ 000D MOVZWL (NAM_DSC), =(SP) : 2669 
04 AO OD 06 PUSHL  4(NA : 2668 
000000006 0 FB D CALLS #3, COBSSSETUP_TERM_TYPE : 
0 E E BLBS = RO, 11 : | 
DD OOOE PUSHL : 2671 
64 01 FB OO00E CALLS #1, LIBSSTOP : 
66 D5 OOOEB 118:  TSTL  COBSTERM_TYPE : 2673. 
03 12 OOOEA BNEQ  12$ : | 
65 Q DO OOOEC MOVL #3, COBSTERM_TYPE + 2675 
E DD OOOEF 128 PUSHL SP + 2681 
08 AF 9F OOOF? PUSHAB OUT_BUF : | 
53 DD OO0F4 PUSHL PUT~FLAG : 2680. 
7E F8 AD 2%C OO0F6 MOVZWL ANS"STRING, (SP) : 
FC AD DD OOOFA PUSHL ANS STRING*4 + 2679 
66 DD OOOFD PUSHL COBSTERM_TYPE : 
000000006 00 06 FB OOOFF CALLS #6, COBSSSET ATTRIBUTES : 
05 50 £8 00106 BLBS RO, 138 ; 
57 DD 00109 PUSHL + 2682. 
64 01 FB 00108 CALLS #1, LIBSSTOP ; | 
28 A2 04 AE 3 00105 13$:  MOVAB OUT_BUF, 40(RAB) + 2688. 
22. A 6 BO 0011 MOVW OUT"LEN, 34(RAB) + 2689 | 
52 DD 00117 148 PUSHL RAB > 2695 | 
000000006 00 01 FB 00119 CALLS #1, SYS$PUT : 
000182DA_ BF 50 01 0120 CMPL = RO, #99034 ; 
0B 12 00127 BNEQ 15$ F 
52 DD 00129 PUSHL RAB : 
000000006 00 01 FB 0012B CALLS #1, SYSS$WAIT : 
E311 00132 BRB 4$ : 
OE 08 Ag 58 00134 15$:  BLBS (RAB), 16$ : 2697 
7E 08 A2 7D 00138 MOV (RAB). =(SP) + 2699 
44 Ad OF 001 3¢ PUSHAB 68(RAB) F 
oN DD 0013F PUSHL #1 ; 
7 DD 00141 PUSHL R7 : 
64 0S FB 00143 CALLS #5, LIBSSTOP F 
04 00146 168: RET : 2702 
; Routine Size: 327 bytes, Routine Base: _COBSCODE + 0437 
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ROUTINE DISP_CONVERT ( 
STRING : REF SSTRSDESCRIPTOR, 
ANS STRING : REF S$STRSDESCRIPTOR i 

) : NOVALUE = 


'e¢ 


; FUNCTIONAL DESCRIPTION: 


Convert at data types tc Text 
Input string 

Screen enhancement flag 

Final form of string for output 


— at 


Convert the various VAX-11 COBGL data types to Text for output. 
Call DISP_PARSE to add the final touches. 


FORMAL PARAMETERS: 


STRING. rt.dx address of input string descriptor 


FLAGS. rlu.v screen enhancement flag (not used in this routine 
bold but passed to DISP_PARSE) 
() 


reverse 
blinking 

underline 

bell 

conversion 

decimal point is comma 


0 print sign, 1 do not print sign 
1- 0 For VAX fosoL, : for VAX RPG > 


i 
i 
i 
i 
i 
i 
i 
i 
i 
' 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
ANS_STRING.wt.dx address of ay: tt pve to hold final form of 
' 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
' 
i 
ie 
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string to be displayed on specified device 


IMPLICIT INPUTS: 
NONE 

IMPLICIT OUTPUTS: 
Updated status information. 

ROUTINE VALUE: 
NONE 

! SIDE EFFECTS: 

Converts all VAX-11 COBOL data types to TEXT. 
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BEGIN 
EXTERNAL 
LIBSAB_CVTTP_O, 
LIBSAB~CVTTP"U, 
$AB"CVT_O7U ; 


PPPS 


' for CVTTP 
' for CHSTRANS 
! for CVTITP 
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C ISPLAY VAX=-11 COBOL DISPLAY statement 16-Sep-1984 00:02:3 AX-11 Bliss-32 v4.0-74 Page 35 
Reis 1er8een13be 93:98:23 Hebe sae cage Seen eS2;1 9 tT). 
> 1254 760 BUILTIN 

; 1255 761 CVTTP, 

3 3 $ 76 CVTPS, 

3 3 76 CVTLP ; 

s 4 : 764 

3; 125 765 LOCAL 

: 1260 76 TEMP_DESC : BLOCK (12,BYTE] INITIAL (0) VOLATILE, 

: 1261 76 ' Local temporary fyeer peer 

: 126 768 TEMP VECTOR C18 BYTE), ! Must hold up to 18 packed digits 
3 126 769 TEMP_LEN INITIAL (05, i Length of temporary desc 

> 12646 770 RES_BESC BLOCK (12,BYTE] INITIAL (0) VOLATILE, 

3; 1265 771 ' Local temporary ggscriptor 

: 1266 77 RES VECTOR (23,BYTEI, ' Must hold up to digits 

: 1267 77 ! for double i Lose ine 

3: 1268 774 TEMP BUF : VECTOR (8,BYTE), ' Needed for CHSTRANSLATE to reshuffle 
; : +4 uP? STRING_BUF : REF VECTOR (8,BYTE), Needed jor DSCSK_DTYPE_NLO 

3 ' conversion 

3; 1271 77 SIGN INITIAL (0), ! Hold sign for DSCSK_DTYPE_NLO 

3 1 Lf 778 WORD_TO_LONG INITIAL (0), ' Needed for CVTWL 

: 127 779 STR WORD INITIAL (0), ! Used by STRSCOPY_R 

3 1274 780 LOOK FOR_SIGN INITIAL (0), ! = 1 if data type requires sign 
3: 1275 781 EXPONENT; ' Scale of string to be converted 
3 1276 78 DIGITS INITIAL (0), ' Number of digits in a COMP data item 
3: 1277 78 CHECK_COMP INITIAL (0), ' TRUNC / NOTRUNC 

3 1278 784 COMP_SCALE INITIAL (0), ! TRUNC / NOTRUNC 

3; 1279 785 PASS_RES : INITIAL (0), ! Flag for DISP_PARSE call 

; 1280 786 ITS_TEXT : INITIAL (0) ; ' lag. if = 1 flo need to call 

; 1281 787 ! DISP_PARSE 

3 1s8¢ 788 LITERAL 

3; 128 2789 F_SIZE =7 ! Needed for call to COBSCNVOUT in DISP_CONVERT 

> 1284 2790 D"SIZE == 16 i Needed for call to COBSCNVOUT in DISP~CONVERT 

>; 1285 2791 OVERPUNCH NEG_ ZERO = 2x'7Dd', ! Representation of overpunch -0 
3 1286 $f LOW_OVERPONCH'NEG_SIGN = %X'4A', ' Representation of overpunch -1 
3 st ag, HIGR_OVERPUNCA_NEG_SIGN = %X'5S2" ; ! Representation of overpunch -9 
3; 1289 795 '¢ 

: 1290 796 ! Create local Googe losers - TEMP_DESC and RES_DESC. : 

; 1291 797 : STRSGETI_DX and STRSFREE1_DX are not used in this routine 

: 1638 oS because we are dealing with CLASSes other than Dynamic 

3 1592 800 

3 1592 801 TEMP_DESC COSCSW_LENGTH] = .STRING CDSCS$W_LENGTH) ; 

3 1 38 80 TEMP_DESC CDSCSB_DTYPE = DSCSK_DTYPE_P ; 

: 129 0 TEMP_DESC COSCSB_CLASS = DSCSK ass SD ; 

3; 1298 04 TEMP_DESC LDSCSA cYherscr = TEMPCO) ; 

3 ' a9 Spe TEMP_LEN = .STRING DSCSW_LENGTH) ; 

; St Boe S_DESC CDSCSW_LENGTH] = .STRING CDSCS$W_LENGTH) ; 

31 808 RES DESC DSC$B-DTYPE] = DSC$K_DTYPE_NL™; 

; 130 809 DESC COSC$B_CLASS = pacer CLASS_SD ; 

; 13s 3i9 RES_DESC CDSCSA_POINTER) = RESCOJ ; 

2 : 4] alg IF .STRING COSC$B_CLASS] EQL DSCS$K_CLASS_SD 

; : 4 aie BEGIN 

; 1310 816 TEMP_DESC CDSC$B_SCALE) = .STRING COSCS$B_SCALE) ; 


—— 


ecabis Saas ibe Rae os ae eee 


~ 16-Sep-1984 00:02:3 AX-11 Bliss-32 V4.0-74 Page 36 
Pit prone earthy aman rt: ce aemmaman aaa 1 99:08:33 COBRTL. AE cékp Sera 68251 (11) 
; 1311 17 TEMP_DESC CDSCSB_DIGITS] = .STRING COSC$B_DIGITS) ; 
: RES_BESC COSCS$SB_SCALE]. = .STRING CDSC$B_SCALE) ; 
; 18 i RES -pERE Ebstsp-piciis2 = .STRING CDOSCSB_DIGITS) ; 
: 1315 1 END; 
aM HE 
: 1 18 8 4 i Get EXPONENT, if class is DSCSK_CLASS_SD, to pass to DISP_PARSE 
; i : $ 5 EXPONENT = ( IF .STRING ‘Wett CLASS] ae DSCSK_CLASS_SD 
3; 1 : 8 THEN .STRING COSCSB_SCALE 
:1 : y ELSE 0) ; 
: 1358 B31 r 
: 1336 8 ¢ i Select DATA TYPE of string to be converted and perform the 
: 132 8 : poceceery conversions. | 
; 1398 ote Object of conversion is to fold all data types to Text. 
; 1330 836 i values : 
> 133 2838 i Although this routine converts all the various data types to TEXT, 
1338 e839 2 ! it is necessary to remember what the grieine data types were. 
; 1334 2840 ! This information is stored in LOOK_FOR_SIGN (with data types grouped 
; 1335 841 ! together when possible) to be used by routine DISP_PARSE in deciding 
> 1336 289 whether a plus sign, minus sign, or space is to be output. 
; 1335 Spek i LOOK_FOR_SIGN = 0 No sign insertion 
; 1339 845 ' — LOOK-FOR-SIGN = 1 Sign is part of string (leading) 
; 1340 84 !  LOOK"FOR-SIGN = ; Trailing sign | 
; 13c4 B49 ! — LOOK=FOR-SIGN = Pos overpunch sign, COMP data types (word, 
: 1342 2848 i > Me ex Longword, and quadword), and Packed data type | 
; : N = -" sign insertion 
: 1300 850 $ ! Ft athe DSC$K_BTYPE_NLO case where minus sign ‘gets 
+ 1345 Be) : ; lost’ in conversion. 
; 1346 3 
: i PASS_RES = 0 Pass STRING to DISP_PARSE 
; 1346 He ; PASS RES =1 Pass RES_DESC to DISP_PARSE 
; 1349 ; 
: i ITS_TEXT = 0 Call DISP_PARSE 
: 1384 HH ‘ Iter Text z 1 No need to call DISP_PARSE 
3 135 != 
: HE Bé0 CASE STRING CDSCSB_DTYPE] FROM DSCSK_DTYPE_WU TO DSCSK_DTYPE_P OF 
; 1386 bss CDOSCSK_DTYPE_NU) : ! Unsigned numeric - 
: 1385 865 LOOK_FOR_SIGN = 0 ; 
: 1361 Ber COSCSK_DTYPE_NL) : ! Left separate sign 
; 1368 3869 LOOK_FOR_SIGN = 1; 
; 1365 i CDOSCSK_DTYPE_NR) : ! Right separate sign 
:1 


'¢ 
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ISPLAY VAX=11 COBOL DISPLAY statement 16-Sep-1984 00:02:3 AX-11 Bliss-32 V4.0-74 Pa 7 
3 107388-1382 13:96:22 COBRTL.SRC COaD 1 SPLA.B 32:1 atte 


3; 1 74 ’ al ae is adjusted because of trailing sign that is 

.% 75 ! included in the string. 

3 3 6 !- 

3 1 7 

3 1 7 BEGIN 

; } 7 If .EXPONENT LSS 0 

3 3 st EXPONENT = S yee -1; 

3 1 88 LOOK_FOR_SIGN = 2 ; 

; : tt END ; 

; } 5 COSCSK_DTYPE_NRO) : ! Right overpunch sign 

3 3 88 BEGIN 

31 888 CVTTP ( STRINGCDSCSW_LENGTH], .STRINGCDSCSA_POINTER], 
; ' 889 LIBSAB_CVTTP=O, TEMP_LEN, TEMP ); | 
3 ; 34 CVTPS ( TEMP_LEN, TEMP, TEMP_LEN, RES ); 

31 89 LOOK_FOR_SIGN = 3; 

3 3 894 PASS_RES = 1 ; 

3 1 895 3 

3; 1 896 

3 : 344 CDSCSK_DTYPE_NLOJ : ! Left overpunch sign 

3 1 2899 BEGIN 

3: 1 900 

3:1 2901 LOOK_FOR_SIGN = 3 ; 

3; 1396 90 

3 ieee 90 '¢ 
3; 1398 904 ! CHSTRANSLATE Loses ‘=" sign. 
3; 1399 2905 ! Read sign before performing CHSTRANSLATE. If a minus 
3; 1400 2906 ! sign was pect of the original string, preserve it ages 
3 1401 2907 ' LOOK_FOR_SIGN. DISP_PARSE will insert the lost minus sign 
: one 44) ' in the final form of the string. é 
: 140 909 ' Note: a give sign is not lost, plus sign is always given 
3 1404 soit ! by CHSTRANSLATE regardless of the original sign. 
3; 1405 911 '- 

> 1406 saig ; 

3; 1407 91 STRING_BUF = .STRINGCDSCSA_POINTER) ; 

3: 1408 914 SIGN = .STRING_ BUF ; 

3 1409 915 IF .SIGN GEQ LOW_OVERPUNCH_NEG_SIGN AND ! If between -1 

3: 1410 916 -SIGN LEQ HIGH_OVERPUNCH_NEG_SIGN ' and -9 then 

3 14611 917 EN ! preserve neg sign 

3 lg 918 LOOK_FOR_SIGN = 4 

3 141 919 ELS 

3 1414 920 IF .SIGN EQL OVERPUNCH_NEG_ZERO ' If -0 then : 

3 1415 921 ! preserve neg sign 

3 1416 9 é LOOK_FOR_SIGN = 4 ; 

3 1417 9 

3; 1418 924 

3 1419 925 CHSTRANSLATE ( LIBSAB_CVT_OU o FTRINGCESCOU_LENSTHD, 

> 1420 326 -STRINGCDSCSA_POINTERI, 0, 

3 i? 1 ; -STRINGCOSCSW_LENGTH], TEMP_BUFCO) ); 

3 14 5 G § CVTTP ( STRINGCOSCS$W_LENGTH], TEMP_BUFCO), 

3 1424 930 LIBSAB_CVTTP_U, TEMP_LEN, TEMP ); 


— bt 
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CVTPS ( TEMP_LEN, TEMP, TEMP_LEN, RES ); 
PASS_RES = 1 ; 
END ; 
CDOSCSK_DTYPE_PJ) : ! Packed decimal 
BEGIN 
CVTPS (¢ STRING EDS CEM LENGTH « STRINGCDSCSA_POINTER], 
STRINGLOSCSW_LENGTHJ, RES ); 
3 
4 
& 
4 


— 
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CDSCSK_DTYPE_W, DSCSK_DTYPE_WUJ : ! Signed and unsigned word 
ieee NOTE: For COMP data items (WORD, LONGWORD, QUADWORD), VAX-11 COBOL 
: is passing an SD decriptor for both the S$ and SD class. 
BEGIN 


Although 4 is the maximum number of digits in a VAX-11 

COBOL Word Integer, a length of 9 is used because conversion 
is actually from Longword to Packed. Need the number of 
digits possible in Longword. 

svee’ ges cee of leading zeros will be necessary (done in 
DISP_PARSE). 


PAA AVIMUI & 
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LONG = [BLOCKL.STRINGCDSCS$A_POINTER],0,0,16,1; BYTE) ; 


WORD_TO_LONG , TEMP_LEN, TEMP ) ; 
MP“LER, TEMP, TEMP_LEN, RES ); 


t 
LOOK_FOR_SIGN = 3; 
PASS-RES "= 1 ; 


tt es 


LEN = ° 
ESC COSC$W_LENGTH) = 9 
T0 = 

( 


oooovnon 
SQN 
ewn—oo 


d number gigits in COMP data oe to pass to DISP_PARSE. 
W_ LENGTH) is always 2 for WOR 


' Rea 
975 ! .STRING COSC . 
! Number of oie! s is between 1 and 4 for WORDs. 
! If DISSK_CLASS_S => During the conversion process the WORD 
! data typé was First converted to a LONGWORD. This introduced 
five ‘extra’ preceding zeroes which will be disgarded by 


DISP_PARSE. 


CHECK_COMP = 1; 
If; STRINGCDSCSB_CLASS3 EQL DSC$K_CLASS_SD 
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c ISPLAY VAX=11 COBOL DISPLAY statement 1b-sep-1984 99:08: 3) Bret Ohisge 32 V4.0-74 Page 39 


1 14-Sep-19 COBR COBDISPLA.B52;1 (11) 
4 END 
¢ 3 ELSE i GITS 1 
=e]: 
eo OR , . 
Z 938 COSCSK_DTYPE_L, DSCSK_DTYPE_LU] : ! Signed and unsigned longword 
489 995 BEGIN 
490 4 
491 99 '¢ 
138 338 ! 9 is the maximum number of digits in a VAX-11 COBOL 
49 ! Longword Integer. 
494 000 ! Suppression of leading zeros will be pecossary if length 
ree Bp) of input string is less than 9 (done in DISP_PARSE). 
OB : 
498 TEMP_LEN = 9 ; 
$99 005 RES_BESC CoSC$wW_LENGTH) = 9 ; 
501 009 CVTLP ( .STRINGCOSCSA_POINTER], TEMP_LEN, TEMP ) ; 
308 008 CvTPS ( TEMP_LEN, TEMP, TEMP_LEN, RES ); 


LOOK_FOR_SIGN = 3 ; 
PASS RES = 1 ; 


i Read eunper digits in COMP data item to ee to DISP_PARSE. 
! .STRING CDOSCSW_LENGTH] is always 4 for LONGWORDs. 
} Number of digits is between 5 and 9 for LONGWORDs. 


C 


HECK_COMP = 1; 
TF gS TRINGLDSCSB_CLASSI EQL DSCS$K_CLASS_SD 
BEGIN 
DIGITS = .STRINGCDSC$B_DIGITS) ; 
COMP_SCALE’ = » STRINGCDSC$B_SCALE) ; | 
ELSE | 
DIGITS = 0 ; 
END ; 
COSCSK_DTYPE_QU, DSCSK_DTYPE_Q] : ! Signed and unsigned quadword 
BEGIN 


! 18 is the maximum number of digits in a VAX-11 COBOL 

' Quadword Integer. 

! Suppression of leading zeros will be necessary if length 
! of input string is less than 18 (done in DISP_PARSE). 
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0 TEMP_LEN = 18 ; 

1 RES DESC cos¢su LENGTH) = 18; 

5 (COBSCVTOP_RO (O,.STRINGCDSCSA_POINTER],.TEMP_LEN,TEMP)) ; 
3 043 CVTPS ( TEMP_LEN, TEMP, TEMP_LEN, RES ): 


q 
+ 


an } 
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39 5 LOOK_FOR_S] 3: 

40 6 PASS “RES”= + 

¢ § i Read number gigits in COMP data iten to pass to DISP_PARSE. 
4 ! STRING LDSCSW_LENGTH] is always {or QUADWORDs. 
re: 3} : Number o digits is between 10 and 18 for QUADWORDs. 
4 CHECK_COMP = 1; 

<3 0 5 IF . STRINGCDSC$B_CLASSJ EQL DSCSK_CLASS_SD 

rf 054 THEN 

4 5 BEGIN 

° § DIGITS = pStRinel veces bisits) : 

08 ae = .STRINGCOSC B_SCALEJ ; 

3g 38 ELSE 

ee 44 DIGITS = 0; 

5 END ; 

37 O38 COSCSK_DTYPE_FJ ! Floati int 
228 +44 maak & : ! oating poin 


'¢ 
! 14 is the Length of the E-Notation format that is used 


for the Floating Point data type: 
Notarion representation of -1 i -0.1000000E+01 ) 


tah ahh 4) 4d 4) Ab Ah Ab ah Ah Ad 


'¢ 

! 23 is the length of the E-Notation format that is used 

! for the Double Floating Point data §7e8 

! ( E_Not representation of -1 is -0.1000000000000000E+01 ) 
STRSCOPY_R is done here because DISP_PARSE will not be called 


095 


(E s 
206 STRSCOPY_R is done here because DISP_PARSE will not be called 
568 7 ‘ 
569 7 RES_DESC CDSCSW_LENGTH] = 14 ; 
570 % STR-LEN = 14 ; 
371 O77 1F Rot ( COBSENVOUT (.STRINGCDSCSA_POINTER], RES_DESC, F_SIZE)) 
378 079 LIBS$STOP (COBS_ERRDURDIS) ; 
574 80 IF NOT ( STRSCOPY_R ( .ANS_STRING, STR_LEN 
375 081 ais -RES_DESC EDSCSA_POINTER] ) ) 
$77 O88 , LIBSSTOP (COBS_ERRDURDIS) ; 
t4 p32 Change the result 0.1110000E+03, to 1.110000E+02 
581 OB ADJUST_FL_PT ; 
2 : 088 ITS_TERT = 1; 
H 44 END’; 
585 oh COSCSK_DTYPE_DJ : ! Double floating point 
; 09 BEGIN 
5 
5 


$333 


vw 
TREES 
Sssesseseess 
MSWN—oCO 
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RESLESELS 


Pann 
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a] 
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33 
3 3 
3 7 
3 7 
3% 
3 7 
3 3 
3% 
3; 1 
3% 
7 
3 
3 7 
3 3 
3 7 
3 3 
3 7 
3 1 
3 7 
3 7 
3 7 
3 
3; 1 
3 7 
3% 
3 
3; 7 
3 7 
3 3 
3 7 
3; 1 
3 1 
3 7 
3 3 
31 
3 7 
3; 7 
3 3 
3 % 
3 7 
3 7 
3 7 
37 
3 7 
3 7 
3% 
3 7 
3 7 
3 7 
3; 7 
37 
3; 1 
3 
3 7 
3 7 
3 7% 
3 1 


Sania ES aac Rp eine sip ge [ 
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BES -DESC CRSCoW LENGTHS = 23; 

STR_LEN = . 

con ( coBstnvouT < «STRINGCOSCSA_POINTER], RES_DESC, D_SIZE)) 
LIBSSTOP (COBS_ERRDURDIS) ; 


IF NOT ( STRSCOPY_R ( .ANS_STRING, STR_LEN 
-RES_DESC EDSCSA_POINTER] ) ) 


SSSSss 


se 


THEN 
. LIBSSTOP (COBS_ERRDURDIS) ; 


_ PEBEB ABBA REESE E2 907008150807 10 


a 


ADJUST _FL_PT ; 
' ITS_TERT = 1; 
1 * 
} COSCSK_DTYPE_T] : ! Text 
i BEGIN 
1 ‘+ 
1 
1 


i User requested conversion of a TEXT string. Empty request, 
! no harm done = don't call DISP_PARSE, 
STRSCOPY_R is done here. 


STR_LEN = .STRING CDSC$W_LENGTH) ; 
IF NOT ( STRSCOPY_R ( .ANS_ STRING. STR_LEN, | 
.STRING COSCSATPOINTER] ) ) | 


THEN 
LIBSSTOP (COBS_ERRDURDIS) ; 
Its Text = 1 | 


DWONAVESWN —OOONOULSWN oO 


CINRANGE, OUTRANGE) : 
LIBSSTOP(COB$_INVARG) ; 


' 

' Call routine to parse the converted seeing and put it in acceptable 
! form for the call to SPUT in COMMON_SCREEN. 
! DISP_PARSE will 

: nsert sign 
i 

' 

' 


APAAAAAAAAAAAAAAAAAAAAAAAAAAAAO 
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L 
VYES_ZERO : INITIAL (0) ; 
IF (.STRINGCOSCSB_CLASS] EQL DSCS$K_CLASS_S) 
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640 
641 insert decimal point or comma 
O66 suppress leading zeroes : 
7 copy final form of input string to ANS_STRING 
645 
646 IF .ITS_TEXT EQL 0 
64 THEN 
$68 BEG! 
64 

0 

1 
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1 30-1980 1:96:03 COBRTL. RCICOBDISPLA.B 231 
THEN 
YES_ZERO = 1 
ay BEGIN 
YES_ZERO = gSTRINGEDSCSO_DIGITSI + .STRINGCDSCS$B_SCALE) ; 


IF_ .YES_ZERO 
THEN 

YES_ZERO = 1 ; 
ND ; 


DISP_PARSE (( IF .PASS_RES 
THEN RES DESC 
ELSE .STRING ) , 
-FLAGS, .LOOK_FOR SIGN, .EXPONENT, .DIGITS, .ANS_STRING, 
-YES_ZERO,~.COMP_SCALE, .CHECK.COMP ) ; 
END ; 
END ; ! End DISP_CONVERT 
0057 -BLKB 2 
00000000 00580 P.AAR: ‘LONG 0 
00000000 00584 P.AAS: LONG 0 
-EXTRN LIBSAB_CVTTP_O, LIBSAB_CVTTP_U 
-EXTRN LIBSAB~CVT_O-U 
OFFC 00000 DISP_CONVERT: 
.WORD Save R2,R3,R4,R5,R6,R7,R8,R9,R10,R11 
5E 98 AE 9E 00002 HOVAB =104(SP5, §P 
EE AF “ 04 2¢ 90006 MOVCS #4, P.AAR, #0, #12, TEMP_DESC 
5B D4 00008 CLRL_ —‘TEMP_LEN 
EB AF 04 2C 0001 MOVCS #4, BLAAS, #0, #12, RES_DESC 
44 AE 0016 
54 7C 00018 CLRQ = SIGN 
20 AE B84 OOO1A CLRW STR_LEN 
14 AE 7C 0001D CLRQ = DIGITS 
0C AE 7€ 000 9 CLRQ COMP _SCALE 
04 AE 7C 000 CLRQ = ITS_TEXT 
SA 4 AC 00 00026 MOVL STRING, R10 
C AE A 80 99 A MOVW (R10), TEMP DESC 
—E Ae 5 MOVB el. fEMP_DESC+ 
SFA 09 00 MOVB , TEMP BESC+3 
60 AE 50 AE 9E 00 MOV TEMP, TEMP DESC+4 
58 6A 3C€ 000 MOVZWL R105, TEMP LEN 
44 AE 6A 80 0 MOVW (R10); RES BESC 
46 AE 1 30 04 MOVB #16, RES DESC+2 
47 AE 0 MOVB #9, RES DESC+3 
48 AE 2c AE 9 O4A MOVAB RES, RES_DESC+4 
6 p F CLAL (SPS 
09 03 AA 91 CMPB 3(R10), “9 
16 1 BNEQ 4 
6E INCL (SP) 
0059 MOVE 8(R10), TEMP_DESC+8 


™m 
3 
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ee 


wr 
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020000000000 
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itt meets re ee ee hg Pt ie Oe 096 i) 
65 AE 9 AA MOVB (R10), TEMP_DESC+9 : 2817 
4C AE : AA ; MOVB BRI). RES_DESC+8 ; B18 
4D OA AA MOVE (R10), RES-DESC : 81 
0 6E : 1$ BLBC 3E._s«s¢ SP), 8 : 2827 
1c AE 08 AA 98 f cVTBL grid, EXPONENT t 2828 
1¢ AE 04 00077 28 CLRL XPONENT : 2827 
3 03 02 AA BF 9 7A 3$ CASEB 2(R10), #3, #18 : $80 
26 ot org Occ 7F 4$ «WORD $-4$.- : | 
$3 $56 is bos Hat te ae 
et 08h 3 0097 3-4$,- : 
026 4E 009F 0$-4$,- : | 
$-4$,- é 
$-4$,- 3 
$-4$,- ‘ 
45$-4$,- : 
eg : 
63$-4$,- : 
6-48. : | 
$-4$,- : 
12$-4§,- : 
$-4$,- : 
11$-4$,- : | 
5$-4$,- 3 
18$-4§ : | 
000000006 8F DD OO0AS S$: PUSHL #coBs INVARG : 3139 
000000006 00 01 FB S00A8 CALLS LTBS$STOP ; | 
17 11 0008 BRB 108 : 
18 AE D4 000B4 6S: CLRL LOOK FOR_SIGN : 2865 | 
7B (11 90087 BRB 7$ ; 
18 AE 1 D0 00089 7$: MOVL #1, LOOK_FOR_SIGN : 2869 
5 11 0008D BRB 17 3 
1c «(AE ODS 0008F 8$: TSTL ponent + 2879 
03 18 000c2 BGEG 69S pak 
1¢ AE D7 0004 DECL EX PONENT ; 2881 
18 AE 9 DO 000C7 9S: MOVL LOOK_FOR_SIGN > 288 
C 11 000CB 10$: BRB 5 286 
58 000000006 00 04 BA - 6A 26 90¢D 11$:  CVTTP (R10), @4(R10), LIBSAB_CVTTP_O, TEMP_LEN, - ; 2888. 
2c AE 58 50 AE 5 08 0009 CVTPS ie LEN, TEM olen _LEN, RES : 2891. 
18 AE 03 00 O00E0 MOVL COOK <F : 2893 | 
4A 11 OOE4 BRB > 2894 | 
18 AE 03 09 £6 12$:  MOVL {00K FOR “Sigh, : 2901 | 
04 AA p OOEA MOVL he STRING BUF : 313 | 
4 60 9A OOOEE MOVZBL (STRING BUF). SIGN > 2914 | 
0000004A_ =s BFF 54 01 Fl CMPL Ign. #74 3: 2915 | 
9 19 000F8 BLSS § : 
00000052 = &F 4 D1 OOFA cRPL IGN, #82 : 2916. 
0000007D —&F , i itt 13$: CPL GN. #125 > 2920. 
18 AE 4 a 14$:  MOVL #4, LOOK _FOR SIGN : 922. 
000000006 00 00 , BA 6A oF 116 15$:  MOVTC (Ro) az (R10), #0, LIBSAB_CVT_O_U, (R10), =; 5955 | 
5B 000000006 00 io a 6A 26 Bio CVTTP (RIOT, UT EMP _BUF, LIBSAB_CVTTP_U, TEMP_LEN, =; 2929. 
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50 AE 
2C soAE 58 AE 
ao i 
2c AE 6A 04 BA A 
1 AE 3 
0 AE 1 
1 AE 2 
A 
58 3 
44 a +] 
04 A 
50 AE B 5 
2c sOAE 58 50 AE ; 
18 AE 3 
08 AE 1 
10 A 01 
4 Be 
14 AE 1 
4E 
58 09 
44 SOE 09 
50 At 58 04 Wn 
58 \ 
44 A 1 
5 50 AE 
58 58 
57 04 af 
000000006 00 
2C AE 58 50 AE 0 
18 AE 0 
08 AE 01 
10 AE 01 
0c 6€ 
14 AE 09 AA 
0c AE 08 AA 
03 
14 ~=AE 
021D 
44 AE E 
20 «AE 3 
48 AE 
04 AA 
000000006 $0 3 
D 0 
00000000G_ 8F 
000000006 00 4 


¢ i 
C 


3 
000000006 : 


000000006 60 


_—— 
soz 


-8 


127 
0 1 
p 1 198: 
1 17$: 
0 136 188: 
D 1 
0 14 
14 
1 149 19%: 
DO 00148 20S: 
33 135 
5 a8 
50 Oot69 
DO 00166 
a Bie 
CE tal 
11 00175 21$: 
DO 00177 22$: 
BO OO17A 
F9 OOI7E 
11 00184 
DO 00186 23$: 
BO 00189 
4 0018D 
DO 00191 
DO 00194 
D4 00198 
16 OO19A 
08 gt 248: 
DO 001A7 
DO 001AB 
dO ola 
+H 0183 
A 00186 25$: 
98 00168 
11 OO1C 
% 001C2 26$: 
1 OO1C 7$: 
88 01C8 28$: 
BO OO1CC 
) B10 
fF 10 
DD 0010 
f 3108 
E 10F 
dD Ries 
FB OO1E 
0 pier 298: 
f ite 
DO OOTF 
DD 001F9 
f 308 
DD $50 
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TEMP 
TEMPALEN, TEMP, TEMP_LEN, RES 
HI PASS_RES 

(R10), @4(R10), (R10), RES 
#3, LOOK_FOR_SIGN 


2 

#9, TEMP_LEN 
“9 RES _DESC 

@4(R10)> WORD_TO_LONG 
WORD_TO LONG, TEMP LEN, TEMP 
TEMP LER, TEMP, TEMP_LEN, RES 
#3, COOK FOR_SIGN 

oa CHECR. COMP 

(SP), 25$ 

#1, OIGITS 

27$ 


#9, TEMP_LEN 
#9. RES _DESC 
a4(R10)> TEMP_LEN, TEMP 


24 

#18, TEMP_LEN 
#18, RES_BESC 
TEMP, RY 


R 
COBSCVTOP_R9 
TEMP LEN, TEMP, TEMP_LEN, RES 
#3, COOK’FOR_SIGN 

#1. PASS"RES 


R_COMP 


DIGITS 
COMP_SCALE 


se. 
ow 


~rn 
n” 
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SCNVOUT 
RRDURDIS 
$STOP 
C+4 

ING, R4 
SCOPY_R 


ERRDURDIS 
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| COBSDISPLAY VAX=11 COBOL DISPLAY statement 1B.56 -1984 00:02:3 AX-11 Bliss-32 V4.0=-74 Page 4 
itt 12-808- 1382 90:08:25 COBRTL.SRCJCOBDISPLA.B32;1 ° ais, 
6140 01 A140 9 BS 43$:  MOvB 101) CANS BUF I, (x) CANS_BUF J : 
F6 51 sof . BB 44$: AOBLEG si FT_ALC, X, 43$ : 
44 AE 1 80 C2 45$ MOVW #23, RES_DESC : 103 
20 AE 17 8 C6 MOVW #23, STRILEN : 3103) 
10 po CA PUSHL #16 + 3104 
48 AE OF CC PUSHAB RES BESC : 
04 AA DD OOOCF PUSHL  4(RTO) : 
000000006 00 ; FB 0 De CALLS i, COBSCNVOUT : | 
> pooo0000c ar Be oop BUSNL #COBS ERROURDIS + 3106. 
000000006 00 1 FB ° ts CALLS #1, LYB$STOP : 
48 AE pp ES 46$ PUSHL RES_DESC+4 : 3108, 
34 AE 9F OOCEC PUSHAB STRILEN : 3107) 
54 C AC DO OOCEF OVL § ANS-STRING, R4 : | 
54 DD O02F3 PUSHL R4 : 
000000006 00 93 FB 002F5 CALLS #3, STRSCOPY_R ; 
0D 0 €E8 O02FC BLAS : 
000000006 BF DD OOoFF PUSHL #COB$_ERRDURDIS > 3110 
000000006 00 01 FB 00305 CALLS #1, LYBS$STOP : | 
50 046 A& 00 09 o¢ 47$:  MOVL  4(R4), ANS_BUF : 
OA 02 AA 91 0031 CMPB 2(R105, #10 ; 
OE iF 0314 BNEQ  48$ : 
56 OB DO 00316 MOVL #11, E_SIGN : 
51 0D 00 99 19 MOVL #13, ETONES : 
52 0C 00 0031¢ MOVL #12. E-TENS ; | 
58 OC 00 0031F MOVL Wi2, SRIFT_ALL r 
OC 11 00322 BRB 49$ : 
56 14 DO 00324 48$ MOVL #20, E_SIGN ; | 
51 16 00 00 7 MOVL #22, E“ONES : 
52 15 DO 0032A MOVL 1, E-TENS : 
58 15 00 0032D MOVL #21, SAIFT_ALL : | 
04 08 AC 06 Ei 005 0 49$ BBC "6 FLAGS 50$ : 
02 Ad e¢ 0 00 MOVE #44, 2(ANS_BUF) : 
51 0 £0 99 9 50s ADDL2 ANS.BUF, RT ; 
30 $1 1 0033c CMPB)sC(RIS, #48 : 
7 12 0033F BNEQ 55% ; 
30 6240 91 00341 CMPB cf TENS) CANS_BUFJ, #48 : 
31 Ne 0 43 BNEQ 558 ; 
0c 8 D1 0034 CMPL SHIFT_ALL, wi2 : 
05 if 0034A BNEQ 1$ : | 
55 09 »D 00 4C MOVL #9, SEARCH ; 
03 11 O034F BRB 52§ : 
55 if D9 6 1 518: MOVL #18, SEARCH : 
02 D 4 52$:  MOVL #2, P : 
09 11 00357 BRB 54$ : 
30 6340 91 00359 53$ CMPB = (P) CANS_BUF], #48 : 
13 0035p BEQL 548 : 
57 1 00 0035F MOVL #1, CHANGE : 
F3 3 5 F 62 548 AOBLEQ SEARCH, P, 53$ : 
01 7 01 CMPL CHANGE, 8 : 
3 3 6 BNEQ 2? ; 
6640 D 90 00368 MOVB #45, (E_SIGN)[ANS_BUF : 
6240 0 30 of MOVB #48, (E~TENS) CANS BUF : 
61 19 3 MOVB #49, (RT) ; 
3 11 8 BRB 3 
28 6640 91 78 55$:  CMPB (E_SIGN)CANS_BUF], #43 ; 
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Routine Base: _COBSCODE + 0588 


1065 bytes, 


; Routine Size: 
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VAX=11 COBOL DISPLAY statement 


ROUTINE DISP 
STRING 


: REF BLOCK (12, BYTE], 
FLAGS 
LOOK FOR_SIGN, 


: REF BLOCK (12, BYTE), 


14 
FUNCTIONAL 


FORMAL PARAMETERS: 


EXPONENT. rlu.v 


1E-Seoc}9Be 99:02:5)  yAKett BLiegc Sz v4,007 


9 

9 

! Put together a number 
! Input string, result of conversion 
! Screen enhancement flag 

; pcee for sign insertion 

! Decimal exponent 

! Number of digits in COMP data items 
! Holds final form of string 

' for output 

! =1 Print the 0 before the dec pt 

' Scale of Comp data item 

' TRUNC / NOTRUNC issue with COMP 

! Make sure that no more digits 

! are Displayed than the number 

! in the PIC of the Comp data item 


DESCRIPTION: '‘ 


Put string in final form for output - 
insert sign 
insert decimal point or comma 
suppress leading zeroes 
copy final form of input string to ANS_STRING 


! 


address of input string descriptor 
screen enhancement flag 


bit 0 - bold 

bit 1 =- reverse 

bit ¢ - blinking 

bit - underline 

bit 4 = bell 

bit 5 = conversion 

bit 6 = decimal point is comma 

bit 7 = 8 print We 1 do not print sign 
bit 11 = 0 for VAX COBOL, 1 for VAX RPG 


LOOK_FOR_SIGN.rlu.v vloe set in DISP_CONVERT to aid in gign insertion 
p 


arameter list for call to DISP_PARSE. 


0 No sign insertion 

1 Sign is part of string (leading) 

¢ Trailing sign 
Pos overpunch sign, COMP data types (word, 
longword, and quadword) and packed data Y ‘ge 

4 orate sign must be inserted (DSCSDTYPE_NL 
case 


an 


Decimal exponent - signed power of ten from DSC$B_SCALE 
used to convert internal to external form 


Number of digits in a VAX-11 COBOL COMP data item, 
Word, Longword and Quadword. 


_—— 


A 
aS 
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form of 


ANS_STRING.wt.dx address of Gener’ tor to hold f of ade 
ed device 


string to be displayed on pecttl 
IMPLICIT INPUTS: 

NONE 
IMPLICIT OUTPUTS: 


Status updated for STRSCOPY_R 


~ 
SRIF AR UNOS 


oe 


! ROUTINE VALUE: 
NONE 
SIDE EFFECTS: 
Copy the final form of the string to ANS_STRING. 


i] 
REF VECTOR (65535, BYTE], ! Addresses temp buffer BUF _DESC 

ER : IN L (0) ' Counter for BUF 

NG_BUF : REF VECTOR (65535, BYTE), | Addresses STRING 

N : WORD, ! Length of STRING 
! Max power of ten in result 
! Min power of ten in result 

“ (BYTE(O)), Temp to hold sign of string 
' 
t 
' 
' 
' 
4 


“M- TowvOor 
— ce 


T 

T 
Ow_P 
IGR_STR: 
IRST_GOOD : ' Used for leading zero suppression, 

! signals first non-zero signigicant 

! digit was encountered. 

' Used for leading zero reper restos. 

' signals that the only ‘ok” Leading 

' zero is the zero in front of the 

! decimal point if the # is a fraction. 


SSNS SSS SNS SSS SSS SSS 


PAAAMNMAMMNNMN NI BEEP EEE 
WN "SO CONOUESWN"OOONOUSWN—O 


at 


ZERO_OK : INITIAL (0), 


SSIS 


—"OOCONOUSWN OO 


DOT_HERE ir 
EXTRA AL (0), ' # of extra leading zeroes in a 


WWAAAAAIANAANAA AA AWWW 
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bP 6 tet tet te tee PR PRN RP ASAE BS OO RR Hy tte Set a el, late ee 
VFwWn—oO 


1 

' COMP data item that resulted 

' from the conversion process. 
PULL : WORD INITIAL (0), ' Keeps track of the # of leading 

' zeroes pulled from STRING. 
MINUS : INITIAL (0) ; ' Signals that a minus sign is 

' to be inserted 
BIND 
ZERO = UPLIT ('O") ; 


a 
VME WUIN 0 OONOU EWN (OC OONOA UNE WI 3 0 ODNAOUSWIR)—OWO 


SSN NNN SSS SSS 


COONAN NANNING 


'¢ 
Enable a handler to free the local string in case of error. 


pe] 
a8 


Bee Se Ge Se Se Se Se Se Ge Ge Se Se Se Se Se FH Se Se Se Se Ge Sete Ge Ge Ge Ge Ge Ge Ge Se FH Se Ge Ge Ge Se Se Se Se Se Ge Se Se Se Se Ge Se Se Se Se Seas ee tee 
Be he at aD 8 8 se as ds hs 4 es 4s > 2 — —) 4 2 4 4 2 9 sa es 4 os a a = a a ts ts a tt tt 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
BEGIN 
LOCA 
BUF_DESC : BLOCK £9, OTT ) YOLATILE. ! Local temporary buffer 


—O Oo 


aa 
Se 
fora 


NABLE 
COBSSFREE_STRINGS (BUF _DESC); 


a ] 
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83 § te 
7 94 ! Create local descriptor BUF_DESC. Allocate enough space to hold the 
: 95 : Starts. a leading sign (or Space), and an imbedded decimal point (or 
: 39 i Calculate Limits for loop that reads digits. 
79 38 te 
794 
795 STRING_LEN = .STRING POSCeu LENGTH}: 
196 91 STRING-BUF = .STRING CDSCS$A~POINTERI; 
138 BUF _DESC CDSCSW_LENGTH] = 0; 
BUF “DESC ps¢$B_bTvPE) = DSCSK_DTYPE_T; 
800 5 BUF _DESC LDSCS$B_CLASS = DSCSK_CLASS_D; 
801 S BUF DESC LDSCSA_POINTER] = 0; 
08 '¢ 


; Calculate Limits for loop that reads digits. 


Seeeee 


HIGH_POS = MAX (.STRING_LEN + .EXPONENT = 1, =1); 
LOW_POS = MIN (.EXPONENT, 0); 


33 


te 

! If the resultant number has too many digits to be represented on 
VAX, give an error message. 

if ee es - .LOW_POS + 3) GTR 65535) 


LIBSSTOP (COBS_INVARG) ; 


os te ss ss os tn 


MEW OC CONOUE WN “OC OONOUSwnN Oo 


ocate space for local string. 


! ALL 
STRSCOPY_R allocates space for ANS_ STRING but not for BUF _DESC. 


IF - ( STRSGET1_DX (ZREF (.HIGH POS = .LOW_POS + 3), BUF_DESC) ) 


LIBSSTOP (Cops ERRDURDIS) ; 
BUF = .BUF_DESC CDSCSA_POINTER); 


'¢ 


i Calculate number of extra leading zreoes introduced in DISP_CONVERT 
,_ that were not part of the original input string passed to COBSDISPLAY. 


FUNSSSSSNSRAN SS Sanenrww—ofo 


FWA WA AAA AIR RURINININURUNUN 2 


10D CD CD Od Cd C9 CD CD OD CD Od OD 09 Cd CD 09 CD Cd C9 GD 09 OD CD OD CD CD 


If .DIGITS EQL -1 
THEN 
EXTRA =5; 
IF .DIGITS GTR 0 
EXTRA = .STRING_LEN = .DIGITS ; 
'¢ 


! Read sign, put either ‘+’, ‘=", or space into BUF, incr PUTTER 
! (Can't read trailing sign yet) 


Bo Be Se Ge Be Se Se Se Ge Se Ss Se Ge Fe Ss Se Ge Se Ge Se Ge Se Se Fe Fe Se Ge Se Ge Gs Ge Se Fe Se Ge Se Se Se Se Se Ge Ge Se Se Ge Se Se Ge Se Se Se Se ee Ge Se Se we 


me a a a a a Ok a a a kd tk td = a = 8 a 3 
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. le 


Fpl OR FR SIM EQL 1 OR .LOOK_FOR_SIGN EQL 3 


'¢ 

! These data types will not output a ‘+" if the number was positive, 
: @ space will be output instead. 

BEGIN 


LOCAL 
P_IND : INITIAL (0); ! Equals 1 if string has P in picture 


— COSCS$B_CLASS] EQL DSCSK_CLASS_SD 
ad = ABS(.STRING COSCSB_SCALEJ) GTR .STRING CDSC$B_DIGITSJ) 
' 


ba 
! Strings with Ps in the picture have the sign in STRING_BUF(O). 
! Replace sign with zero so there won't be a double sign in 

the result. 


BEGIN 


86 
5 
is 


; MINUS = 1 that a minus sign is to be inserted in BUF. 
4 zSie@i_sm EQL ZC*+* OR .SIGN_STR EQL %C'-* 

BEGIN 

fr 5sensie EQL 2C‘-' 


© 
oo 


00 09 09 Co 09 Od Co 
3332 
eee 
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HEH BAAN MAAN. AAA AANAA HAHA BB BE BAW BAIN IIUnonononononononn» 


ee ee a ka a ee ek ee a a ad a a od a 


Ss 


870 SIGN_STR = .STRING BUF (0) ; 
871 CHSMOVE (1, ZERO, STRING_BUF ([0}); 
He END 
874 ELSE 
875 nige SIGN_STR = .STRING_BUF [(.EXPONENT + .STRING_LEN = 1) = .HIGH_POS] 
877 SIGN_STR = .STRING_BUF C(.EXPONENT + .STRING_LEN = 1) = .HIGH_POS) ; 
879 te 
880 ! If no sign in original input string, insert a space before 
881 HH] ! the number. 
ry 8 ! Do not output the plus sign if present - output a 
88 88 ! space instead. Minus sign will be inserted 1 EDIATELY before the 
884 89 : first significant digit ( bb-12.3 not -bb12.5 ). For now, 
885 90 ! put a space in BUF as a place holder, take care of sign 
Hy 4 insertion Later. 
588 38 BUF C.PUTTER] = XC" * ; 
9 94 PUTTER = .PUTTER + 1 ; 
By 95 a 
9 $ i A minus sign is always included for output. Sigel through 
+44 
01 
08 
05 
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MINUS = 1 ; 
IF (.LOOK_FOR_SIGN EQL 1) AND (NOT (.P_IND)) 
HIGH POS = .HIGH_POS = 1 ; 
END ; 
END; 
se where minus sign was lost in routine DISP_CONVERT = signal through 
NUS = 1 that _a minus sign is to be inserted in BUF. Minus sign if 
inserted IMMEDIATELY before the first significant digit ( b “12, 
t -bb12.5 ). For now, put a space in BUF as a place holder, take 
care of sign insertion (ater, incr PUTTER. 


if .LOOK_FOR_SIGN EQL 4 
THEN 


BEGIN 
MINUS = 1; 

SIGN_STR = %C'-" ; 

BuF T.PUTTER] = 2¢° * ; 
PUTTER = .PUTTER + 1; 
END ; 


+ 
Must create a dummy string for strings with picture of the form 
9(x)P(x). The reason for this is that what is in STRING does not 
cps tess the placeholders at all and therefore the code that puts 
NO 
( 


e result in BUF does not work properly. 
TE: NEW_DIGITS 


IF (.STRING CDSC$B_CLASS) EQ DSCSK_CLASS_SD) AND (.DIGITS EQL 0) 
ba IF .STRING COSC$B_SCALE) GTR O 


THE 
BEGIN 
: Picture is of the form 9(x)P(x). 


LOCAL 
BLOCK 8.BYTE , 


UMMY : Dummy string which will have placeholders in it 
DUM_STR : VECTOR (20,BYTEJ, i 


Must hold wy to 18 numeric strin 
digits = also making room for sign 
and decimal point 


NUM_CHARS; 
DUMMY CDSC$W_LENGTH] = 20; 

cmmy CDSCSB-DTYPE] = DSCSK_DTYPE_T; 
Duemy EDSCSB-CLASS) _ = DSCSK CLASS; 
DUMMY CDSCSATPOINTER) = DUA_STR LO): 


'¢ 
! Zero the whole dummy string so that zeroes will end up wherever 
the digits and sign aren't 


ae 


ego wenn nee mee Hho mee LS alls parang 


IESEEHOEE SGA) EGMONT 
ARS = .DUMMY COSCSW_LENGTH); 


STRSDUPL CHAR (DUMMY, NUM“CHARS, ZERO); 

If STRING CDSCSB_DTYPE] EQL DSCSK_DTYPE_NR 
BEGIN 
Right separate - 


i Dummy string should have the digits in STRING moves 
i into it first, then the placeholder zeroes, then the 


BS 
Ooo 
GEARS 


SeESESEELES 


i sign. 
am 
NUM CHARS = STRING coscsy LENGTH] = 1; ! Number its 
71 CHSMOVE (.NUM eS HARS. TRING COSCSA a.polnren) . DUMMY Poscsh po POINTER) | 
CHSMOVE aan "STRING COSCSA. POINTER] “© NUM CHARS, .DUMMY CDSCSA_POINTER] + .NUM_CHARS + .EXPONEN. 


oo 
| 
| 


LSE 
— COSCSW_LENGTH] EQL .STRING CDSC$B_DIGITSJ 


14 

i Left and right overpunched - 

i Dummy string should have the sign moved into it first, 
: _then the digits in STRING, then the placeholder zeroes. 


_csmove (.STRING COSC$W_LENGTH] + 1, .STRING CDSCSA_POINTER], .DUMMY CDSCS$A_POINTER]) 
'¢ 
i Left separate - 


i Dummy string should have the digits in STRING moved 
a into it first then the placeholder zeroes. 


ae 
SSSESESRER ST 


BPH FWSUANINININININININIWNIA EB BB EB BAMA BBB BPP BEE EE Pt 


ELS 


Seseesessesesss 


ooo0o 
Se 


a et et a ee a a a a a a a a a a a a dd 
yo ao 
oooo 
wns 


89 
4 : BEGIN 
pad 4 3 CHSMOVE (.STRING COSC$W_LENGTH] - 1, .STRING CDSCSA_POINTER] + 1, .DUMMY CDSCSA_POINTER]); | 
99 98 HIGH POS = .HIGH POS - T; 
994 499 STRING_LEN = . STRING LEN’ - 1; 
397 208 . 
998 50 STRING_BUF = .DUMMY CDSCSA_POINTER]; 
999 504 
p00 505 END; 
002 309 ts 
00 508 ! Now read (rest of) number inserting decimal point (or comma). 
004 509 ! Put result in BUF. 
005 219 te 
00 313 DECR POS FROM .HIGH_POS TO .LOW_POS DO . 
43 AF BEGIN ! Begin loop 
010 515 IF (.POS EQL -1) ! Decimal point/comma insertion 
011 218 THEN ! When pos = -1 we are about to 
Big 51 BEGIN ' read the first digit to the 
1 218 ! right of the decimal point 
014 51 !¢ 


5 
; 
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SUSAR 
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! Do 53° suppress zeroes immediately following the decimal point 
' (,00 shoyle not get .2 as a rosy t 

! If the decimal point is the first significant character in the 
: number, check to see if it is nesessary ge insert a minus sign 
! 


before the decimal point. -.002 ) 


migh 
IF .HIGH_POS EQL -1 
THEN 

BEGIN 

FIRST GOOD = 1 ; 

if -MINUS EQL 1 


BUF C.PUTTER = 1] = .SIGN_STR ; 
END ; 


1+ 
When requested, use a comma in place of a decimal point, 


IF (.FLAGS AND V_DEC_PT) NEQ 0 


BUF C.PUTTER] = XC',’ 
ELSE 

BUF C.PUTTER] = XC’.'; 
DOT_HERE = .PUTTER ; 
PUTTER = .PUTTER + 1; 


'¢ 
Read number, one digit at a time. Put digit in BUF, incr PUTTER 


a eee EQL 2 AND .POS EQL .LOW_POS 


Ieetting sign - this case also outputs a space instead of a 
sign 


When .POS = -LOW_POS we are reading the last digit. if we 
have a trailing Sign data type - that Last digit is the sign. 
Make sure there is something in BUF before inserting the sign. 


BEGIN 
IF .PUTTER EQL 0 ' Check for nothing in 
THEN ! BUF 

BEGIN 

BUF _C.PUTTER] = %C'0" ; 

PUTTER = 1 ; 


ELSE 
IF .BUF C.PUTTER - 1) EQL %C° ° ' Check for only spaces 
' in BUF 


BUF C.PUTTER = 1] = &C'O" ; 
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7 7 SIGN_STR = .STRING_BUF C(.EXPONENT * .STRING_LEN = 1) = .POS) ; 

7 , i «SIGN_STR EQL Tare > 

74 7 HEN 

Le : ne C.PUTTER] = &C° ' 

f § BUF C.PUTTER] = .SIGN_STR ; 

8 ELSE 

5 BEGIN 
1 '¢ 
277? This needs a comment. 

Be : 4 if ((.POS GTR (.STRING_LEN + .EXPONENT = 1)) OR (.POS LSS .EXPONENT)) 
eH 531 THEN | 
08 9 i Put trailing, but significant, zeroes in BUF. 
088 298 ' (zeroes to fete of dec inal oint) 
089 594 ! NOTE = this also puts placeholder zeroes to the right of 
090 595 ! the decimal point for STRING with picture of form P(x)9(x). 
091 238 ! This is why a dummy string did not have to be set up for 
44 44 _ that form. 
094 599 BUF C.PUTTER] = %C'0' 
095 ELSE 


SS 
o 
— 


PWL ANAS WWW NINN NNN BIE BULB EE ERR EERE REE ERE P EPP PUP PPE EEE 


‘+ 
} Put digit in BUF. 


S333 
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100 608 

101 5] IF .LOOK_FOR_SIGN GEQ 0 AND .LOOK_FOR_SIGN LEQ 2 
iss 0 THEN 
10 608 BUF C.PUTTER] = .STRING_BUF C(.EXPONENT + .STRING_LEN = 1) 
198 $10 ELSE re | 

| 
198 3611 BUF C.PUTTER] = .STRING_BUF [C(.EXPONENT + .STRING_LEN = 1) 
10 \¢ - (.PO0S - 19]; 
108 361 END ; 
OBS . 
'¢ 

111 oy | ! Search for leading zeroes. : 

Ng 1 ! Ifa sooetag zero is encountered - replace it with a space, 
11 18 ! and leave FIRST_GOOD set at 0. t 
114 19 ! The first digit encountered that is not a zero will turn off 
118 6 ? } the search by setting FIRST_GOOD to 1. 

11 

i 6 5 if gf IRST_G00D EQL 0 

120 5 IF .BUF C.PUTTER) EQL %C'0' 

121 $ THEN 

1 ‘ IF (.ZERO_OK Fo, Q AND 

1 8 (( .POS EQL 0) OR 

126 9 ((.POS EQL 1) AND (.STRINGCDSCSB_DTYPE) EQL DSCS$K_DTYPE_NR) 

125 0 AND T.EXPONENT GEQ 0)7 

1 $ 1 ) AND .YES_ZERO EQL 1) 
¢} : THEN 

128 63 BEGIN 
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— 


' 

' Leave zero before decimal point if number is less 
} than 1. ( ie. -.1 should be output as -0.1 
ZERO.OK = 1; 

FIRST_GOOD = 1; 

IF .“YNUS EQL 1 


SOGEAF 


MEN 


3 21 4 

; 2) 4 

; 1 4 

; 21 4 

3; 21 4 

3 ay & 

3; 21 0 4 

3; 21 1 4 THEN 

: 21 § BEGIN 

: 21 4 

; 21 4 ! Insert minus sign immediately before the first 
3 2140 5 ! significant digit. Reset MINUS to zero to signal 

: 123 $ completion of sign insertion. 
; 128 : BUF C.PUTTER = 1] = .SIGN_STR ; | 
3 2146 MINUS = 0 ; | 
3: 21465 0 4 END ; 
3 re 1 4 END 
3 2146 § LSE 
3; 2148 IF .DIGITS NEQ 0 
3; 2149 4 THEN 
3; 2150 5 '¢ 
3 2151 $ ! Pull out leading zeroes that were introduced in the 
3 136 i } conversion process (to COMP data items). 
3 2154 IF .PULL LSS .EXTRA | 
3; 2155 THEN 

3: 2156 4 BEGIN 

3; 2157 4 PUTTER = .PUTTER - 1 ; 

3; 2158 4 PULL = .PULL + 1 ; | 
3; 2159 4 
; 2160 ELSE 
3; 2161 + 
; 166 ! Wo more ‘extra’ leading zeroes to putt. Replace 
3 216 ! leading zeroes that were part of the original 
3 2164 ! string (string passed to COBSDISPLAY) with | 
3 19? spaces. 
3 167 if .putter lss .dot_here or .dot_here eql 0 
3 en 
; ya BUF C.PUTTER] = %C° ° 
3; 2170 else 
3 2171 buf C.putter] = %c'0' 
; 176 ELSE 

3 2174 ! We are not dealing with a COMP data item (original 

3 2175 ! string before conversion), there are no ‘extra’ 

3 1% ' leading zeroes. Replace a leading zero, that was 

3 4 part of the original string, with a space. 

3 199 if .putter lss .dot_here or .dot_here eql 0 

: 2180 then 

3; 2181 BuF C.PUTTER] = %C° ° 

3 36 else 

3: 218 buf C.putter) = %c'0' 

3: 2184 

3: 2185 ELSE 
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VAK=11 COBOL DISPLAY statement 


AAI IPIPIPIPOPIPONITNINI WII BPRINPINININININININ AWW BS BB BEEP PPP PEPE PPP PPP EEE 


BEGIN 
14 


i We have qncounteres a digit that is not a zero, stop search 
for leading zeroes. 


FIRST GOOD = 1; 
1F .MINUS EQL 1 
THEN 


+ 
Insert minus sign immediately before the first 
significant digit. No need to reset MINUS as 
FIRST_GOOD = 1 prevents this section of code from 
being entered again. 


Do not write over the decimal point if we have 
space - dec pt - oienetaegnt digit in BUF 
! Bug was comp SV9 value -.9 giving -9 


le 
if .DOT_WERE EQL 1 
BUF C.PUTTER - 2) = .SIGN_STR 


ELS 
BUF C.PUTTER = 1] = .SIGN_STR ; 
END ; 


PUTTER = .PUTTER + 1; 

END; ! End loop 
! Check that at least one zero digit is DISPLAYed if the number is zero. 
! Do not allow only a sign, decimal point/comma or space to be output 


: without at least one zero. 
! Getting “. “* want ** .0° 


(.BUFCI) EQL 2C°.* OR .BUFCI) EQL 2C*,") 
AND (.BUFC2) EQL 2C* * OR .BUFC2) EQL 2C*-")) 


!' space dot space 


IF ((. PUTTER EQL 3) a (BuFEN} EQL 2C° * OR “BUFET) EQL 2C°-") 


Hid yy 
BUFC2) = %C°O" ; 
END ; 


'¢ 
! Avoid disploy of too gory digits for a COMP item - look at the 
! DIGITS and SCALE field of the input STRING (from ACC_CONVERT) 
! Trunc/Notrunc issue 


4 -CHECK_COMP EQL 1 


N 

BEGIN ! Begin COMP data item check 
LEFT _DEC ! # of digits you SHOULD have 
RIGHT_DEC, i to left and right of dec pt 


Nn 7 
1en$ep=198e 12:16:42 — ECdartussne Scoop! sPca.882:1 
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PAPAS 


COONAOUS WOO 


DVIVIV IVI DED SVS. PD PVPS BITE BS BB NANA BB PAD BB PW 
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14-Sep-1 COBRTL.SRCJCOBDISPLA.B32;1 
HAVE _LEFT ! # of digits you DO have 
HAVE-RIGHT ; i to left and right of dec pt 
IF .COMP_SCALE NEQ 0 
THEN 
BEGIN ' Class SD - look at DIGITS 
LEFT_DEC -DIGITS + .COMP_SCALE ; ! field for ‘true’ number of 
RIGHT DEC = .DIGITS = .LEFT_DEC ; ! digits to DISPLAY 
ELSE 
BEGIN ' Class S$ = VAX COBOL has passed 
LEFT DEC = ,DIGITS ; ! an SD desctipter = look at 
RIGHT_DEC = 6 ; i DIGITS field for ‘true’ number 
END ; ! of digits to DISPLAY 


' Is what I have within the Limits ? 

' If what we have is ew than what we expect (according to DIGITS), 
' pull the extra 4h $s 

! ex: Pic 99v99 gets 123.456 but should be changed to 23.45 


IF .DOT_HERE NEQ 0 
THEN 


BEGIN ! Begin SD Class 


! Use DOT_HERE (postion of decimal point in BUF) to calculate 
the character you have to the left and right of the dec pt. 


HAVE_LEFT = .DOT_HERE - 1; ! <1 for sign 
HAVE-RIGHT = :PUTTER - .DOT HERE - 1; 
IF (.HAVE_LEFT GTR .LEFT_DEC OR 

"HAVETRIGHT GTR :RIGHT_DEC ) 


Too many digits 


BEGIN 
LOCAL 
TEMP VECTOR (25, BYTE), 
Y INITIAL (OS, ' Ptr to TEMP 
K INITIAL (0) ; ' New PUTTER 
' Peel from BUF backwards 
cess 1 TO .DOT_HERE - 1 DO ! Leave sign alone 
TEMP C.Y) = .BUF C.DOT_HERE - .XJ ; 
Ve veils; 
END ; 
DECR | FROM .LEFT_DEC TO 1 DO ! Put desired # of 
BEGIN ! digits before dec pt. 


BUF C.1] = .TEMP C.K) ; 

Ke £13 
BUF cnetd = .BUF C.DOT_HERE) ; ' Put dec pt/comma in 
K= K +2; !' new position in BUF 


LERRSN 


w 
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WWI AAA AAA AIRPORT 2 2 OOO 
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8 
VAX=11 COBOL DISPLAY statement hese -1984 00:02:3 AX-11 Bliss-32 V4.0- 
1e-Sep-19 4 90:08:23 ECOBRTL SRE COBDISPLA 
INCR_S FROM 1 TO .RIGHT_DEC dO ' Put desired # of 
BEGIN ! digits after dec pt. 
UF (.K] = .BUF C.DOT_HERE + .S] ; 
Ke K¢is 
END ; 
PUTTER = .K ; 
END ; 
es ! End SD Class 
BEGIN ! Begin S$ Class 


PUTTER = 1 (for sign) is the number of characters you have. 


HAVE_LEFT = PUTTER = 1 ; 
HAVE RIGHT = 0 ; 
IF (.HAVE_LEFT GTR .LEFT_DEC OR 
eHAVE_RIGHT GTR .RIGHT_DEC ) 
HEN 
BEGIN 
LOCAL 
TEMP VECTOR (25, BYTE), 
v INITIAL (05, ' Ptr to TEMP 
K INITIAL (0) ; ! New PUTTER 
! Peel from BUF backwards 
Jo 1 TO .PUTTER = 1 DO ' Leave sign alone 
TEMP C.Y] = .BUF C.PUTTER = .xX) ; 
zr see 
END ; 
DECR I FROM .LEFT_DEC TO 1 DO ' Put desired # of 
BEGIN ! digits before dec pt. 


BuF C.J] = .TEMP C.K) ; 
K=K +1; 


END ; 
PUTTER = .K #1; 
END ; 
END ; ! End Class S_- 
END ; ! End COMP data item check 


pds gt hetyeen signed COMP/COMP3 and unsigned COMP/COMP3. 

Look at bit 7 of FLAGS passed by the COBOL Compiler. There is 

no such data item in the COBOL compiler as an unsigned COMP. : 
TO get rid of sign = shift contents of BUF up 1, overwriting the sign 
with is in BUF C0]. Decrement PUTTER by 1. 


-FLAGS AND V_NO_SIGN ) NEQ 0 AND .CHECK_COMP NEQ 0 
BEGIN 
'¢ 


i There is a difference between a string coning into the DISPLAY 
! routines from the ACCEPT routines than one that does not 


ans ] 


ISPLAY VAX=11 COBOL DISPLAY statement Sep-1984 00:02:3 AX-11 Bliss-32 V Page 61 
ett 1b sen 1984 90:98 ia3 COBRTL.SR REIC cosp!s ey B82: 31 . 18} 
° } pass through the ACCEPT routines. 
64 LOCAL 
22 Y INITIAL (0) ; 
8 INCR X FROM 1 TO .PUTTER = 1 DO 
re 4 BEG! 
8 & BUF C.Y) = .BuF C.x] ; 
0 4 Y=.¥e#; 
871 END ; 
ars PUTTER = .PUTTER = 1 ; 
sf END ; 
74 
875 '¢ 
a78 Copy the final form of the string to ANS_STRING 
78 
M6 IF NOT ( STRSCOPY_R (.ANS_STRING, PUTTER, .BUF ) ) 
+t LIBSSTOP (COBS_ERRDURDIS) ; 
Hy '¢ 
884 ! Free local string. 
885 : Wo need to worry about problems with VM as the length of BUF_DESC has 
Hy ! mot been changed since STRSGET1_DX (BUF_DESC). 
888 
889 STRSFREE1_DX (BUF_DESC); 
890 1 END; ! end of DISP_PARSE 


00981 .BLKB 3 
00 00 00 30 009B4 P.AAT: ASCII \O\<0><0><0> ; 
ZERO= P.AAT 
OFFC 00000 DISP_PARSE: 

.WORD Save R2,R3,R4,R5,R6,R7,RB,RI,R10,R11 : 3178. 
SE AC AE 9E 00002 MOVAB =84(SP). SP ; | 
2C «AE «D4 00006 CLRL PUTTER > 3256) 
20 AE 94 00009 CLRB = SIGN_STR ; | 

18 AE 7¢ 900¢ CLRQ  ZERO~OK : 

57 D4 O000F CLRL DOT _RAERE ; 

146 AE B4 00011 CLRW = EXTRA : 

10 AE B4 00014 CLRW = PULL ; 

OC AE D4 00017 CLRL MINUS ; 

4C AE 7C OOO1A CLRO BUF DESC ; 
D 044F CF DE 0001 MOVAL $- (FP) : | 
A 06 Ac D 99 MOVL STRING, R10 : 3300. 
08 AE 6A B80 000 MOVW (R10), STRING_LEN : | 

04 =A 4 AA 06 6 A MOVL 4 (R105, 4(SP) : 3301 

5 4 AE D f MOVL  4(SP), STRING_BUF : | 
EAE “© OE 36 00 a a ee 3300, 
4F AE 65 30 00 A MOVB #2, ‘BUF _DESC+3 ; 3505 | 


pape l 


FFFFFFFF 


50 
OOOOF FFF 


000000006 
28 
000000006 


090000006 
FFFFFFFF 
14 


14 AE 
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SOOOoooooooooooooooooooooooooo 


Be 92:16:42 — ECdantussneic 


BUF _DESC+4 
STRING LEN R2 
EXPONER A11 

ohcRt CR2I, RO 


#1, RO 
RO HIGH_POS 
Rif, R 


RO 
RO, LO 


W_POS 
OW POS, HIGH_POS, RO 


(RO) 
R3, hoses 


#COBS_INVARG 
#1, LITBSSTOP 


By _DESC 
R3,~40(SP) 

#2, STRSGET1_DXx 
RO, 4$ 
#COB$_ERRDURDIS 
#1, LYBSSTOP 


BUF _DESC+4, BUF 
DIGITS, #-1 


6$ 


DIGITS, R2, EXTRA 
LOOK FOR SIGN. #1 


R4 


R11, RO 


HP 
RO) 


OBDISPLA.B852;1 


1 
RING BUF), SIGN_STR 
0, (STRING_BUF) 


0§ RO 
STRING_BUFJ, SIGN_STR 


Poe 5 


313 
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2C BE46 
2 8G 
20 20 
2D 20 
- OC A 
0 
02 
04 oc 
OC AE 
20 AE 
eC BE46 
és 
09 3 
14 
08 
44 AE 010E0014 
48 AE 30 
28 AE 44 
FE8A 
2c 
4C 


000000006 99 


48 


wow 
om 
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48 BE 04 =«OBE 


7E 04 AE 
48 BE 9E 
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ON ONIN NIE “DOOM F $$ OO DNONM OD BM HBAROMOMNUMNIVUIN $= AOOCONR) — NWO) "WFO 
SOOSOCOOCOOOOOSOOOOOOSOSCOOSOSOSOSSOSOSOOSCOOOOSOOOOOOOOOOOOOOOOOOOOOOOO 
SOOOOCOSOCOOOCOOSOOOSOOSOCOOSOCSOSOSOSSSOSoSSSOSSOSSCOSOSSOSCOCOSCOCOOOOOOOOOOOOOOO 
pe ee ee ae Se ae ane Se ae ner ne ae nee ae ane a a ne a ae ae ae a a a a ee er ae er ee er er er er ee er er er ee ee er er er er er er er er er ee er er er et 
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~13be 93:98:23 HetaT Shes cosa Veaen 62.1 


#32, aPUTTERCBUF J 
GN_STR, #43 

N_STR, #45 

SIGN_STR, #45 


0S 
LOGK-FOR_s1GN, # 
i, MINUS 

tee 


10) 


tg DUMMY 
UM_STR bUMM Y¥+4 
UMAY, NUM_ CHARS 


NUM oe 


#3, STRSDUPL_CHAR 
2(R10), #18 


(R10), NUM_CHARS 
NUM_CHARS 
NUM~CHARS, @4(SP) 
NUM~ CH ARS, DUMMY+4, 


4(SP), R1 
@NUM_CHARSCR1], (R11)CROJ 


48, 
W324 
BR 
17$ 
DIGITS 
21 

(R 
21$ 
#17 
D 


—. 


(R10), RO 
RO, (R10) 
(R10), RO 
RO, @4(SP), @DUMMY+4 
‘a RO 
4 (SP) -(SP) 

nO: a(SP)+, aDUMMY+4 
HIGH “pos, 
STRING 

SUMAY SES “STRING _BUF 
STRIN R2 ~ 
HIGH_POS, POS 
44$ 
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ic ISPLAY VAX=11 COBOL DISPLAY statement 1-se -1984 00:02:3 AX-11 Bliss-32 V4.0-74 P 4 
itt VerSep-1986 aitbsae — EedantuesneScosplseca.682;1 age 43} 
FEFFFFFE © 8F 0 01 .001DD 228:  CMPL POS, #1 : 
i if 164 BNEO : _— 
FEFFFFFFE © 8F 38 : 166 CML HI H_POS, #=1 : 3527. 
1C AE Ot 08 dorEe MOVL #1, FIRST_GOOD : 3530. 
01 0c AE D4 1F3 cMPL 8 hus. ral : 3531. 
51 56 ¢ AE cf 1F9 ADDL3 PUTTER, BUF, R1 : 3533. 
FF OA AE 90 OO1F MOVE. SIGN SfR, -{(R1) : | 
53 56 C AE C1 00203 238 ADDL3 PUTTER, BUF, R3 : 3542. 
05 08 ac 6 3 020 BBC #6 FLAGS, b4$ : 3505 
§ 39 80598 gi _— 
63 2E 99 99 12 4s: MOVB #46, (R3) + 3544. 
57 C AE OD 15 25$: MOVL PUTTER, DOT_HERE : 3545 
C AE D6 00219 INCL UTTER + 3546 
51 C AE DO 0021C 26$:  MOVL PUTTER, R1 : 3366, 
02 CAG Di a0 26 CMPL OOK_FOR_SIGN, #2 ; 3553, 
6E $0 D1 00226 CMPL POS, LOW_POS ; | 
D if 0229 BNEG 308 ; 
51 D5 00208 TSTL = RV. : 3566) 
OA 12 0022 BNEQ 27$ ; | 
6146 0 90 00 ¢ MOVB #48, (R1)CBUFI > 3569 
Fo gr Bleep ak Bly ren ae 
20 FF Alag 1 00 39 27$: CPB -1(R1)CBUFI, #32 : 3573) 
FF A146 3 90 $0 ib MOVB #48, -1(R1)(BUFI : 3575. 
‘ $ es ba 
20 AE FF A149 §§ 00 4 MOVE. -1(R1)CSTRING gurd. SIGN_STR : 
53 56 2C «AE «C1 0025 ADDL3 PUTTER, BUF, R : 3580 
28 20 A 91 99 3? CHPB SIGN_STR, #43 : 3578. 
63 20 #6 00 30 NOV #52, (R3) + 3580 
63 20 AE 90 00262 298: Move S1GN_STR, (R3) : 358 
A 1100 66 BRB 4$ : 3553, 
53 56 1 C1 00268 30$ ADDL3 1, BUF, R3 : 3399, 
51 FF AB42 SE 00 $¢ MOVAB -1(R11)€R23, RI : 3589. 
Bs 9, 005% gerk, st’ 
5B 50 D1 0 26 CMPL POS, R11 ; 
8 7 BGEQ 3 
63 9 90 £8 318: ROVE #48, (R3) : 3599 
51 FF A24B 9 328 MOVAB =-1(R2)CR11), R1 > 3608 
0c A p 0 TStL OK FOR_SIGN : 3606 
02 0c aC D1 A cHPL LOOK_FOR_ SIGN, #2 : 
54 51 30 ¢3 35 SUBL3 POS, R1, R4 > 3609 
63 644 9 94 move (R4SCSTRING_BUFI, (R3) : 3608 
51 5 £3 9A 33S SUBL2 POS, R1 : 3612 
63 01 Al4 90 MOVE 1 (RI)CSTRING_BUFJ, (R3) ; 3611 


H 8 
Siete on terme ECRH=I9R QQ:NBLEL_Webadh EHNA 


1c OA 2 A2 34%: = TSTL F 1RST_GOOD 
7 A BNEO = ; 
30 63 9 A CMPB sé R3), #48 
63 1 AA BNEQ 403 
18 «OA ‘ AC TSTL ERO_OK 
81 ieee 
F B BEQL at 
01 0 ; B CMPL POS, #1 
D BNE 63 
12 02 AA ? 0 BA CPB (R10), #18 
eS D cp TSTL afi 
1 ¢ BLSS  36$ 
01 1C AC D1 002C4 358:  CMPL  YES_ZERO, #1 
1D 1 (8 BNE 368 
18 AE gt D CA MOVL #1, ZERO_OK 
1C =AE 1 OD 5 MOVL #1, FIRST_GOOD 
en et ae 
51 56 C AE cf 0 8 ADDL3 PUTTER, BUF, R1 
FF OA 0 AE 020 MOVE SIGN STR, -1(R1) 
C AE 04 002E CLRL = MINUS 
4D 11 O02E BRB 43$ 
16 AC D3 O2€7 36$: ‘TSTL GITS 
OF 13 OO2EA BEQL 
16 AE 10 =A 81 O2EC CMPW PULL, EXTRA 
0 é O2F1 BGEQU § 37$ 
2¢ «AE OD? 002F3 DECL PUTTER 
10 A 86 0 re INCW PULL 
39 11 OOF BRB 4 
57 2¢ AE 01 000FB 37S: CMPL PUTTER, DOT_HERE 
4 19 OO2FF BLSS $ 
7 05 00301 TSTL T_HERE 
05 12 0030 BNE $ 
63 0 0305 38$: mova # e. (R3) 
A 1100 BRB 4 
63 9 90 0030A 39$:  MOVB #48, (R3) 
; 11 0030 BRB 43$ 
1¢ AE 1 00 OO30F 40S: Mov. #1, FIRST_GOOD 
01 OC AE 01 00 13 CMPL MINUS, #1 
1 if 0317 41$ BNEO 
01 57 D 19 CMPL  DOT_HERE, #1 
0c le 1¢ BNEQ 
51 56 36 AE gi 1 ADDL3 PUTTER, BUF, RI 
FE AI 0 AE 90 0 nove S1GN_sfR. -2(R1) 
51 56 C AE Cl A 42% ADDL3 PUTTER, BUF, R1 
FF OAT 0 AE F MO SIGN STR, -1(R1) 
.. a 6 43$ INCL PUTTER 
D 7 DECL POS 
bE D1 9 44%: CMPL POS. LOW_POS 
19 C BLSS 453 
FESC 31 f BRW 22$ 
03 am 4 p1 41 45$: = CMPL TTER, #3 
2 é 43 BNEO 
20 6 9 4 CMPB Ss (BUF), #32 
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ISPLAY VAX-11 COBOL DISPLAY statement 1h-s8 -1984 00:02:3 AX-11 Bliss-32 V4.0-74 
ett 12-808-1 982 90:08:25 COBRTL.SRC Coen shcae 2:1 Page $$ 
5 1 A BEQ 46$ : 
2D 68 9 C CHPB (BUF), #45 : 
} Ff BNEQ : 
2e 01 A ; 46$: CAPR I UF), #46 + 3729 
2c 01 Kg 9 C 1(BUF), #44 : 
1 B BNEQ 4 : 
20 02 Ab ? D 47$: CAP ¢(BUF), #32 : 3730 
20 02 Re 9 e} CAPS e(BUF), #65 : 
02 =A % 9 gs MOVB #48, 2(BUF) : 3733. 
0 24 ac 0 498: cMPL cH Ex_COMP, #1 + 3742, 
20 ac OD ry TSTL COMP_SCALE ; 3751 
0D 1 1 BEQL 0$ : 
51 146 «aC 20 ac ¢ 7 ADDL3 COMP_SCALE, DIGITS, LEFT_DEC 3754) 
59 146 «AC 51 C3 7 SUBL FETIDEC. bIGITS, RIGHT_BEC : 3755 
06 0 } BRB $ : 3751 
51 14 AC DO 00385 50s MOVL DIGITS, LEFT_DEC : 3759) 
D4 00389 CLRL RIGHT _DE : 3760) 
7 D3 0388 51$ TSTL  DOT_HERE : 3770. 
D 13 0038 BEQL 60S : 
55 FF A? SE 0038F MOVAB =1(R7), RS : 3777 
52 5 00 00393 MOVL. RS, HAVE_LEFT : 
50 2c AE 7 €3 003% SUBL3 DOT_HERE> PUTTER, RO : 3778) 
D7 00398 DECL HAVE _RIGHT : 
51 52 D1 00390 CMPL HAVE-LEFT, LEFT_DEC : 3780 
14 003A BGTR $ : 
59 : D1 003A CMPL §HAVE_RIGHT, RIGHT_DEC : 3781 
15 003A BLEG 61$ ; | 
29 p4 O3A7 52$ CLRL : 3783) 
C 003A9 CLRO OY : | 
O¢ 11 003aB BRB 54$ : 3790. 
54 57 gS O3AD 538% SUBL3 XX bor wre R4 3; 3792. 
30 AE42 644 0381 MOVE © (R4) (BOF), TEMPLY) ; 
5 0g 0387 INCL : 3793. 
2 F3 00389 54$ AOBLEQ RS, X, 53S : 3790 | 
1 i) 038D INCL : 3796. 
08 1 0 BF BRB 6$ : 
40 90 003c1 55$: MOVB  TEMPCK], (1)CBUF) : 3798 
30 D6 003¢7 INCL : 3799 
1 £5 OO*C9 S68 SOBGTR I, 55$ : 3796 
4 vot MOVB (bot HERE) CBUF], 1(K)CBUFI : 380 
Q CO 0030 ADDL2 #2, R : 380 
D4 003D CLRL : 380 
09 11 0030 BRB 8$ : 
1 C1 00309 578 ADDL3 § bor HERE R2 + 380 
46 D MOVE (R2)(B0F), (x) +CBUF J ; 
F E2 58$:  AOBLEQ RIGHT DEC. S, 57$ > 3805 | 
0 D E MOVL PUTT ; 10 
F 1 EA 59$: BRB : 3770 | 
1 C3 EC 60$:  SUBL3 #1, PUTTER, RS : 3819 | 
5 00 O03FI MOVL RS, HAVE LEFT ; | 
D4 003F4 CLRL —- HAVE_RIGAT : 3820, 
D} 6 CMPL HAVE"LEFT, LEFT_DEC : 3822. 
4 003F BGTR 62$ : | 


Foss SPLay 


3; Routine Size: 


VAX=11 COBOL DISPLAY statement 


HB nel 


EF 


2c 


F6 


000000006 


000000006 
000000006 


0000Vv 


1163 bytes, 


"s 


Routine Base: 


9b 18:46:22 


ibsten 


14-Sep-1 
59 0 } HH 
FE 618: 
p be $38: 
1 
63$: 
644 . oy 
53 : Pg of 64$ 
OF 00c19 
6146 30 AES ° 65$: 
: i} 
‘5 F 3 66$: 
AE .” 2 426 
8 Ac B 67$: 
16 «1 4 
24 AC 05 004 
$0 7e bod 
8s 11 004 
6046 0439 68$ 
sc AE F2 0043E 69S 
C AE 07 0044 
56 OD ere 70$ 
30 AE 9F 0044 
18 as DD 00448 
00 9 fe peek 
0D 0 €8 0045 
00000000G 8F 0D 00458 
00 01 FB 0045 
4C¢ AE 9F 00465 71$ 
00 01 FB 00468 
8 peer 
0000 004 3 72$ 
50 08 AC DO 0047 
50 04 AO DO 00476 
F8 AO 99F OO47A 
1 DD 0047D 
E 70 047F 
7E 046 =#OA D 00481 
CF 03 FB 00485 
04 0048A 


-COBSCODE + 0988 


HAVE_RIGHT, RIGHT_DEC 
67$ 

y 
K 

X, PUTTER, R4& 

Chad tBUFS: TEMPLY] 
RS, X, 63$ 
66$ 
TEMPCKI, (1) CeuF J 

55 

finds’ PUTTER 

FLAGS 

70$ 

CHE CK. COMP 

0$ 

69$ 

(xX) CBUFI, (Y)+CBUFI 
PUTTER, X, 68$ 
PUTTER 

F 

ANS. STRING 
#3, STRSCOPY_R 


R 
#COB$_ERRDURDIS 
#i, LIBSSTOP 


ey bese 
#1, STRSFREE1_Dx 
sexe nothing 
AP), RO 
4(RO), R 
F_DESC 


: 
4 CAP) 
#3, téBssiReE _STRINGS 


AX-11 Bliss-32 V4.0-74 
COBRTL.SRCJCOBDISPLA.B52;1 


Pe Se Se Se Se Be Be Be Se Se Be Se Be Se Se Be Be Se Se Se Se Be Sse Se Se Se Be Se Se Se Se Se Se Se Se Se Ge Se Se Se Be Se Se 


GLOBAL Roy ine COBSSFREE_STRINGS ( 


MECH, 
ENBL 


! Free local strings 
Signal vector 

Mechanism vector 

Enable vector 


~N 
Oo 
wr 


k 8 

ee vont rae Ese: rm 1eo$ep=198e 2:16:42 Eedanteesne coe! sec A-082;1 Poe 485 
i 
i 


oO 
w 


) sz 


tee 
! FUNCTIONAL DESCRIPTION: 


Mie are unwinding, free the local strings. They are passed 
n the enable vector. 


i FORMAL PARAMETERS: 


BSS SSSSSSSSESLSS SSS 


4 
G $1G.rl.a A counted vector of parameters to LIBSSIGNAL/STOP 
40 MECH. rl.a A counted vector of info from CHF 
vet ENBL.ra.a A counted vector of ENABLE argument addresses. 
405 i IMPLICIT INPUTS: 
40 NONE 
408 ‘ 
409 ! IMPLICIT OUTPUTS: 
NONE 


i ROUTINE VALUE: 
i COMPLETION CODES: 


Always SSS$_RESIGNAL, which is ignored when unwinding. 
i SIDE EFFECTS: 
Frees all of the strings passed as enable arguments. 


as Ss ts a 


DWNAVESWUN “OOOO WO 


BEGIN 


WINN RIMINININININININ 3 3 


WMO OONAUES WN “OO ONOU SW O 


SIG : REF VECTOR 
MECH : REF VECTOR, 
ENBL : REF VECTOR: 


DODODODOOOOO OOOO ODODOODOODODVDDO0NDN00N0O 


Fy oy eo oF oy OF oy oo oy ot ot ot ot at at te ee ee 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
3 
1 
1 


1 5 + 
§ : Only free the strings if this is the UNWIND condition. 
i : 
5 +44 : IF ( NOT (LIBSMATCH_COND (SIG [1], ZREF (SSS_UNWIND)))) THEN RETURN (SS$_RESIGNAL); 
941 '¢ 

tee 208 i. through the enable arguments, freeing them. 
440 944 
re ee? INCR ARG_NO FROM 1 TO .ENBL (0) DO 
46 309 IF (..ENBL C.ARG_NO) NEQ 0) THEN STRSFREE1_DX (.ENBL C.ARG_NOJ); 


a 


Ce ee es bite 19:96:2s — Febante Sat icaspy seca eS: 1 Page $9 


3: 2646 
3 gc45 334 ; RETURN (SS$_RESIGNAL); 
3 2646 950 END; ! end of COBSSFREE_STRINGS 


0004 $008 sENTRY COBSSFREE_STRINGS, Save R2 3 tea. 
52 0D 4 ARG_NO 3 3945 
12 11 00004 BRB $ 3 
50 OC BC42 D 66 1$ MOVL @ENBLCARG_NOJ, RO : 3947 
° TSTL (RO) 3 
9 0D EQL 3 
Q oD $4 PUSHL RO 3 
000000006 8 1 Fe 0011 CALLS) #1, ogc Dx 3 
9 oc Be FS 00018 2$ AOBLEQ @ yy NO; 1$ : 
0 0918 F 3C€ 00010 MOVZWL #2328, 3 3949 
04 00022 RET : 3950 


; Routine Size: 35 bytes, Routine Base: _COBSCODE + 0E43 


4 8 
ISPLAY -VAX=11 COBOL DISPLAY stat 9 AX-11 Bliss-32_v4.0-74 
1648 etc sey We-Sep-1986 13:16:42 — EedartLesReScospseLaces2:1 = "88°42 


: 2448 9 } GLOBAL ROUTINE COBSSRET_A_AB_PREV = 
> 26 9 953 1 !4¢ 
; "i M ¢ ! : FUNCTIONAL DESCRIPTION: 
: 26 g 9 § 1/ Returns address of FOBSSAS PREV for code outside the COBRTL image 
; rs ¢ M4 : that needs this variable. 
26 6 989 | | FORMAL PARAMETERS: 
> 24 960 1! 
: 24 8 961 1! NONE 
; 24 206 1} 
3; 2460 1 ! IMPLICIT INPUTS: 
; 2461 964 1! 
: 246 965 1! NONE 
3; 246 208 
3: 24664 967 1 ! IMPLICIT OUTPUTS: 
3 2665 968 1 i | 
5 e4 969 1} NONE | 
3; 246 970 1! | 
3 <8 971 1 ! ROUTINE VALUE: 
; rs i 4A : : COMPLETION CODES: | 
3 2671 974 13 Address of COBSSAB_PREV. 
> 267 975 1! | 
3 247 976 1 ! SIDE EFFECTS: 
3 2474 977 1! 
3; 2675 978 1! NONE 

47 979 1! 
: 247 980 1 i-- 
3; 2478 981 1 
; rt a8 BEGIN 
; 481 984 RETURN COBSSAB_PREV; 
3 288 9 


| 
| 
END; ! end of COBSS$RET_A_AB_PREV | 
| 


0000 000 ENTRY COBSSRET_A_AB =paev. Save nothing 3 951 | 
50 00000000" EF 9€E 0000 MOVAB COBS$SAB_PREV,~R ¢ 3984 | 
04 0000 RET ; 3986. 


; Routine Size: 10 bytes, Routine Base: _COBSCODE + 0E66 


> 2486 987 1 | 
: 2485 988 1 END ! end of module COBSDISPLAY | 
486 989 0 ELUDOM | 


Page 71. 


ISPLAY VAX=11 COBOL DISPLAY statement 16-Sep-1984 00:02:3 AX-11 Bliss-32 V4.0-74 
498 16- sen-1984 90:98:25 COBRTL SRETCORDY SPOA B82: 1 (14) 
; PSECT SUMMARY | 
5 Name Bytes Attributes 
: COBSDATA 55 NOVEC, WRT, RD -NOEXE.NOSHR, LCL, REL, CON, PIC -ALIGN(2) 
; —COBSCODE 3696 NOVEC.NOWRT, RD. EXE. SHR. LCL. REL. CON, PIC.ALIGN(2) 
; Library Statistics 
; eccccses $yebo(s ecoccece Pages Processing 
: File Total Loaded Percent Mapped Time 
; 55$DUA28: (SYSLIBISTARLET.L32;1 9776 120 1 581 00:00. 
; tit nTe COBRTL .OBJJSMGLIB.L32;1 469 4 0 HH $0 00:8 
; COMMAND QUALIFIERS 
; PL ISS/CHECR OCP SELD INET IAL OPT INI ZED /MOTRACE/L 1SH1. 188s COBD1SPLA/0B.J208J5: CORD ISPLA MSRC$: COBDISPLA/UPDATE=(ENH$:COBDISPLA 
3; Size: 3443 code + 308 data bytes 
3; Run Time: 00:51.7 
3; Elapsed Time: 03:19.7 
3 Lines/CPU Min: 4625 
3 ay Ae gle 29863 
; ome he 476 pages 
; Bo way Complete 


AL EQUIPMENT CORPOR 
DENTIAL AND PROPRIE 


AH-BT13A-SE 
VAX/VMS V4.0 


A 
A 


T 
= 


: 


